#!/usr/bin/env perl

# This chunk of stuff was generated by App::FatPacker. To find the original
# file's code, look for the end of this BEGIN block or the string 'FATPACK'
BEGIN {
my %fatpacked;

$fatpacked{"App/Perl/Tags.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_PERL_TAGS';
  #!/usr/bin/env perl
  use 5.006;
  use strict; use warnings;
  
  package App::Perl::Tags;
  use Getopt::Long ();
  use Pod::Usage qw/pod2usage/;
  use File::Find::Rule;
  
  use Perl::Tags;
  use Perl::Tags::Hybrid;
  use Perl::Tags::PPI;
  use Perl::Tags::Naive::Moose; # includes ::Naive
  
  our $VERSION = '0.02';
  
  sub run {
    my $class = shift;
  
    my %options = (
      outfile => 'perltags',
      depth => 10,
      variables => 1,
      ppi => 0,
      prune => [ ],
      help => sub { $class->usage() },
      version => sub { $class->version() },
    );
  
    Getopt::Long::GetOptions(
      \%options,
      'help|h',
      'version|v',
      'outfile|o=s',
      'prune=s@',
      'depth|d=i',
      'vars|variables!',
      'ppi|p!',
    );
  
    $class->usage() unless @ARGV;
  
    $options{paths} = \@ARGV;
  
    my $self = $class->new(%options);
    $self->main();
    exit();
  }
  
  sub new {
    my ($class, %options) = @_;
    $options{prune} = [ '.git', '.svn' ] unless @{ $options{prune} || [] };
    return bless \%options, $class;
  }
  
  sub version {
    print "perl-tags v. $VERSION (Perl Tags v. $Perl::Tags::VERSION)\n";
    exit();
  }
  
  sub usage {
    pod2usage(0);
  }
  
  sub main {
    my $self = shift;
  
    my %args = (
      max_level    => $self->{depth},
      exts         => 1,
      do_variables => $self->{variables},
    );
  
  
    my $ptag = Perl::Tags::Hybrid->new(
      %args,
      taggers => [
        Perl::Tags::Naive::Moose->new( %args ),
        $self->{ppi} ? Perl::Tags::PPI->new( %args ) : (),
      ],
    );
  
    my @files = $self->get_files;
  
    $ptag->process(files => \@files);
    $ptag->output(outfile => $self->{outfile}); 
    return;
  }
  
  sub get_files {
    my $self = shift;
    my @prune = @{ $self->{prune} };
    my @paths = @{ $self->{paths} };
  
    my $rule = File::Find::Rule->new;
  
    my @files = 
      $rule->or(
        $rule->new
             ->directory
             ->name(@prune)
             ->prune
             ->discard,
        $rule->new
          ->file,
      )->in(@paths);
  
    return @files;
  }
  
  =head1 AUTHOR
  
  Copyright 2009-2014, Steffen Mueller, with contributions from osfameron
  
  =cut
  
  # vim:ts=2:sw=2
  
  1;
APP_PERL_TAGS

$fatpacked{"Carp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CARP';
  package Carp;
  
  { use 5.006; }
  use strict;
  use warnings;
  BEGIN {
      # Very old versions of warnings.pm load Carp.  This can go wrong due
      # to the circular dependency.  If warnings is invoked before Carp,
      # then warnings starts by loading Carp, then Carp (above) tries to
      # invoke warnings, and gets nothing because warnings is in the process
      # of loading and hasn't defined its import method yet.  If we were
      # only turning on warnings ("use warnings" above) this wouldn't be too
      # bad, because Carp would just gets the state of the -w switch and so
      # might not get some warnings that it wanted.  The real problem is
      # that we then want to turn off Unicode warnings, but "no warnings
      # 'utf8'" won't be effective if we're in this circular-dependency
      # situation.  So, if warnings.pm is an affected version, we turn
      # off all warnings ourselves by directly setting ${^WARNING_BITS}.
      # On unaffected versions, we turn off just Unicode warnings, via
      # the proper API.
      if(!defined($warnings::VERSION) || eval($warnings::VERSION) < 1.06) {
  	${^WARNING_BITS} = "";
      } else {
  	"warnings"->unimport("utf8");
      }
  }
  
  sub _fetch_sub { # fetch sub without autovivifying
      my($pack, $sub) = @_;
      $pack .= '::';
      # only works with top-level packages
      return unless exists($::{$pack});
      for ($::{$pack}) {
  	return unless ref \$_ eq 'GLOB' && *$_{HASH} && exists $$_{$sub};
  	for ($$_{$sub}) {
  	    return ref \$_ eq 'GLOB' ? *$_{CODE} : undef
  	}
      }
  }
  
  # UTF8_REGEXP_PROBLEM is a compile-time constant indicating whether Carp
  # must avoid applying a regular expression to an upgraded (is_utf8)
  # string.  There are multiple problems, on different Perl versions,
  # that require this to be avoided.  All versions prior to 5.13.8 will
  # load utf8_heavy.pl for the swash system, even if the regexp doesn't
  # use character classes.  Perl 5.6 and Perls [5.11.2, 5.13.11) exhibit
  # specific problems when Carp is being invoked in the aftermath of a
  # syntax error.
  BEGIN {
      if("$]" < 5.013011) {
  	*UTF8_REGEXP_PROBLEM = sub () { 1 };
      } else {
  	*UTF8_REGEXP_PROBLEM = sub () { 0 };
      }
  }
  
  # is_utf8() is essentially the utf8::is_utf8() function, which indicates
  # whether a string is represented in the upgraded form (using UTF-8
  # internally).  As utf8::is_utf8() is only available from Perl 5.8
  # onwards, extra effort is required here to make it work on Perl 5.6.
  BEGIN {
      if(defined(my $sub = _fetch_sub utf8 => 'is_utf8')) {
  	*is_utf8 = $sub;
      } else {
  	# black magic for perl 5.6
  	*is_utf8 = sub { unpack("C", "\xaa".$_[0]) != 170 };
      }
  }
  
  # The downgrade() function defined here is to be used for attempts to
  # downgrade where it is acceptable to fail.  It must be called with a
  # second argument that is a true value.
  BEGIN {
      if(defined(my $sub = _fetch_sub utf8 => 'downgrade')) {
  	*downgrade = \&{"utf8::downgrade"};
      } else {
  	*downgrade = sub {
  	    my $r = "";
  	    my $l = length($_[0]);
  	    for(my $i = 0; $i != $l; $i++) {
  		my $o = ord(substr($_[0], $i, 1));
  		return if $o > 255;
  		$r .= chr($o);
  	    }
  	    $_[0] = $r;
  	};
      }
  }
  
  our $VERSION = '1.3301';
  
  our $MaxEvalLen = 0;
  our $Verbose    = 0;
  our $CarpLevel  = 0;
  our $MaxArgLen  = 64;    # How much of each argument to print. 0 = all.
  our $MaxArgNums = 8;     # How many arguments to print. 0 = all.
  our $RefArgFormatter = undef; # allow caller to format reference arguments
  
  require Exporter;
  our @ISA       = ('Exporter');
  our @EXPORT    = qw(confess croak carp);
  our @EXPORT_OK = qw(cluck verbose longmess shortmess);
  our @EXPORT_FAIL = qw(verbose);    # hook to enable verbose mode
  
  # The members of %Internal are packages that are internal to perl.
  # Carp will not report errors from within these packages if it
  # can.  The members of %CarpInternal are internal to Perl's warning
  # system.  Carp will not report errors from within these packages
  # either, and will not report calls *to* these packages for carp and
  # croak.  They replace $CarpLevel, which is deprecated.    The
  # $Max(EvalLen|(Arg(Len|Nums)) variables are used to specify how the eval
  # text and function arguments should be formatted when printed.
  
  our %CarpInternal;
  our %Internal;
  
  # disable these by default, so they can live w/o require Carp
  $CarpInternal{Carp}++;
  $CarpInternal{warnings}++;
  $Internal{Exporter}++;
  $Internal{'Exporter::Heavy'}++;
  
  # if the caller specifies verbose usage ("perl -MCarp=verbose script.pl")
  # then the following method will be called by the Exporter which knows
  # to do this thanks to @EXPORT_FAIL, above.  $_[1] will contain the word
  # 'verbose'.
  
  sub export_fail { shift; $Verbose = shift if $_[0] eq 'verbose'; @_ }
  
  sub _cgc {
      no strict 'refs';
      return \&{"CORE::GLOBAL::caller"} if defined &{"CORE::GLOBAL::caller"};
      return;
  }
  
  sub longmess {
      local($!, $^E);
      # Icky backwards compatibility wrapper. :-(
      #
      # The story is that the original implementation hard-coded the
      # number of call levels to go back, so calls to longmess were off
      # by one.  Other code began calling longmess and expecting this
      # behaviour, so the replacement has to emulate that behaviour.
      my $cgc = _cgc();
      my $call_pack = $cgc ? $cgc->() : caller();
      if ( $Internal{$call_pack} or $CarpInternal{$call_pack} ) {
          return longmess_heavy(@_);
      }
      else {
          local $CarpLevel = $CarpLevel + 1;
          return longmess_heavy(@_);
      }
  }
  
  our @CARP_NOT;
  
  sub shortmess {
      local($!, $^E);
      my $cgc = _cgc();
  
      # Icky backwards compatibility wrapper. :-(
      local @CARP_NOT = $cgc ? $cgc->() : caller();
      shortmess_heavy(@_);
  }
  
  sub croak   { die shortmess @_ }
  sub confess { die longmess @_ }
  sub carp    { warn shortmess @_ }
  sub cluck   { warn longmess @_ }
  
  BEGIN {
      if("$]" >= 5.015002 || ("$]" >= 5.014002 && "$]" < 5.015) ||
  	    ("$]" >= 5.012005 && "$]" < 5.013)) {
  	*CALLER_OVERRIDE_CHECK_OK = sub () { 1 };
      } else {
  	*CALLER_OVERRIDE_CHECK_OK = sub () { 0 };
      }
  }
  
  sub caller_info {
      my $i = shift(@_) + 1;
      my %call_info;
      my $cgc = _cgc();
      {
  	# Some things override caller() but forget to implement the
  	# @DB::args part of it, which we need.  We check for this by
  	# pre-populating @DB::args with a sentinel which no-one else
  	# has the address of, so that we can detect whether @DB::args
  	# has been properly populated.  However, on earlier versions
  	# of perl this check tickles a bug in CORE::caller() which
  	# leaks memory.  So we only check on fixed perls.
          @DB::args = \$i if CALLER_OVERRIDE_CHECK_OK;
          package DB;
          @call_info{
              qw(pack file line sub has_args wantarray evaltext is_require) }
              = $cgc ? $cgc->($i) : caller($i);
      }
  
      unless ( defined $call_info{file} ) {
          return ();
      }
  
      my $sub_name = Carp::get_subname( \%call_info );
      if ( $call_info{has_args} ) {
          my @args;
          if (CALLER_OVERRIDE_CHECK_OK && @DB::args == 1
              && ref $DB::args[0] eq ref \$i
              && $DB::args[0] == \$i ) {
              @DB::args = ();    # Don't let anyone see the address of $i
              local $@;
              my $where = eval {
                  my $func    = $cgc or return '';
                  my $gv      =
                      (_fetch_sub B => 'svref_2object' or return '')
                          ->($func)->GV;
                  my $package = $gv->STASH->NAME;
                  my $subname = $gv->NAME;
                  return unless defined $package && defined $subname;
  
                  # returning CORE::GLOBAL::caller isn't useful for tracing the cause:
                  return if $package eq 'CORE::GLOBAL' && $subname eq 'caller';
                  " in &${package}::$subname";
              } || '';
              @args
                  = "** Incomplete caller override detected$where; \@DB::args were not set **";
          }
          else {
              @args = @DB::args;
              my $overflow;
              if ( $MaxArgNums and @args > $MaxArgNums )
              {    # More than we want to show?
                  $#args = $MaxArgNums;
                  $overflow = 1;
              }
  
              @args = map { Carp::format_arg($_) } @args;
  
              if ($overflow) {
                  push @args, '...';
              }
          }
  
          # Push the args onto the subroutine
          $sub_name .= '(' . join( ', ', @args ) . ')';
      }
      $call_info{sub_name} = $sub_name;
      return wantarray() ? %call_info : \%call_info;
  }
  
  # Transform an argument to a function into a string.
  our $in_recurse;
  sub format_arg {
      my $arg = shift;
  
      if ( ref($arg) ) {
           # legitimate, let's not leak it.
          if (!$in_recurse &&
  	    do {
                  local $@;
  	        local $in_recurse = 1;
  		local $SIG{__DIE__} = sub{};
                  eval {$arg->can('CARP_TRACE') }
              })
          {
              return $arg->CARP_TRACE();
          }
          elsif (!$in_recurse &&
  	       defined($RefArgFormatter) &&
  	       do {
                  local $@;
  	        local $in_recurse = 1;
  		local $SIG{__DIE__} = sub{};
                  eval {$arg = $RefArgFormatter->($arg); 1}
                  })
          {
              return $arg;
          }
          else
          {
  	    my $sub = _fetch_sub(overload => 'StrVal');
  	    return $sub ? &$sub($arg) : "$arg";
          }
      }
      return "undef" if !defined($arg);
      downgrade($arg, 1);
      return $arg if !(UTF8_REGEXP_PROBLEM && is_utf8($arg)) &&
  	    $arg =~ /\A-?[0-9]+(?:\.[0-9]*)?(?:[eE][-+]?[0-9]+)?\z/;
      my $suffix = "";
      if ( 2 < $MaxArgLen and $MaxArgLen < length($arg) ) {
          substr ( $arg, $MaxArgLen - 3 ) = "";
  	$suffix = "...";
      }
      if(UTF8_REGEXP_PROBLEM && is_utf8($arg)) {
  	for(my $i = length($arg); $i--; ) {
  	    my $c = substr($arg, $i, 1);
  	    my $x = substr($arg, 0, 0);   # work around bug on Perl 5.8.{1,2}
  	    if($c eq "\"" || $c eq "\\" || $c eq "\$" || $c eq "\@") {
  		substr $arg, $i, 0, "\\";
  		next;
  	    }
  	    my $o = ord($c);
  	    substr $arg, $i, 1, sprintf("\\x{%x}", $o)
  		if $o < 0x20 || $o > 0x7f;
  	}
      } else {
  	$arg =~ s/([\"\\\$\@])/\\$1/g;
  	$arg =~ s/([^ -~])/sprintf("\\x{%x}",ord($1))/eg;
      }
      downgrade($arg, 1);
      return "\"".$arg."\"".$suffix;
  }
  
  sub Regexp::CARP_TRACE {
      my $arg = "$_[0]";
      downgrade($arg, 1);
      if(UTF8_REGEXP_PROBLEM && is_utf8($arg)) {
  	for(my $i = length($arg); $i--; ) {
  	    my $o = ord(substr($arg, $i, 1));
  	    my $x = substr($arg, 0, 0);   # work around bug on Perl 5.8.{1,2}
  	    substr $arg, $i, 1, sprintf("\\x{%x}", $o)
  		if $o < 0x20 || $o > 0x7f;
  	}
      } else {
  	$arg =~ s/([^ -~])/sprintf("\\x{%x}",ord($1))/eg;
      }
      downgrade($arg, 1);
      my $suffix = "";
      if($arg =~ /\A\(\?\^?([a-z]*)(?:-[a-z]*)?:(.*)\)\z/s) {
  	($suffix, $arg) = ($1, $2);
      }
      if ( 2 < $MaxArgLen and $MaxArgLen < length($arg) ) {
          substr ( $arg, $MaxArgLen - 3 ) = "";
  	$suffix = "...".$suffix;
      }
      return "qr($arg)$suffix";
  }
  
  # Takes an inheritance cache and a package and returns
  # an anon hash of known inheritances and anon array of
  # inheritances which consequences have not been figured
  # for.
  sub get_status {
      my $cache = shift;
      my $pkg   = shift;
      $cache->{$pkg} ||= [ { $pkg => $pkg }, [ trusts_directly($pkg) ] ];
      return @{ $cache->{$pkg} };
  }
  
  # Takes the info from caller() and figures out the name of
  # the sub/require/eval
  sub get_subname {
      my $info = shift;
      if ( defined( $info->{evaltext} ) ) {
          my $eval = $info->{evaltext};
          if ( $info->{is_require} ) {
              return "require $eval";
          }
          else {
              $eval =~ s/([\\\'])/\\$1/g;
              return "eval '" . str_len_trim( $eval, $MaxEvalLen ) . "'";
          }
      }
  
      # this can happen on older perls when the sub (or the stash containing it)
      # has been deleted
      if ( !defined( $info->{sub} ) ) {
          return '__ANON__::__ANON__';
      }
  
      return ( $info->{sub} eq '(eval)' ) ? 'eval {...}' : $info->{sub};
  }
  
  # Figures out what call (from the point of view of the caller)
  # the long error backtrace should start at.
  sub long_error_loc {
      my $i;
      my $lvl = $CarpLevel;
      {
          ++$i;
          my $cgc = _cgc();
          my @caller = $cgc ? $cgc->($i) : caller($i);
          my $pkg = $caller[0];
          unless ( defined($pkg) ) {
  
              # This *shouldn't* happen.
              if (%Internal) {
                  local %Internal;
                  $i = long_error_loc();
                  last;
              }
              elsif (defined $caller[2]) {
                  # this can happen when the stash has been deleted
                  # in that case, just assume that it's a reasonable place to
                  # stop (the file and line data will still be intact in any
                  # case) - the only issue is that we can't detect if the
                  # deleted package was internal (so don't do that then)
                  # -doy
                  redo unless 0 > --$lvl;
                  last;
              }
              else {
                  return 2;
              }
          }
          redo if $CarpInternal{$pkg};
          redo unless 0 > --$lvl;
          redo if $Internal{$pkg};
      }
      return $i - 1;
  }
  
  sub longmess_heavy {
      return @_ if ref( $_[0] );    # don't break references as exceptions
      my $i = long_error_loc();
      return ret_backtrace( $i, @_ );
  }
  
  # Returns a full stack backtrace starting from where it is
  # told.
  sub ret_backtrace {
      my ( $i, @error ) = @_;
      my $mess;
      my $err = join '', @error;
      $i++;
  
      my $tid_msg = '';
      if ( defined &threads::tid ) {
          my $tid = threads->tid;
          $tid_msg = " thread $tid" if $tid;
      }
  
      my %i = caller_info($i);
      $mess = "$err at $i{file} line $i{line}$tid_msg";
      if( defined $. ) {
          local $@ = '';
          local $SIG{__DIE__};
          eval {
              CORE::die;
          };
          if($@ =~ /^Died at .*(, <.*?> line \d+).$/ ) {
              $mess .= $1;
          }
      }
      $mess .= "\.\n";
  
      while ( my %i = caller_info( ++$i ) ) {
          $mess .= "\t$i{sub_name} called at $i{file} line $i{line}$tid_msg\n";
      }
  
      return $mess;
  }
  
  sub ret_summary {
      my ( $i, @error ) = @_;
      my $err = join '', @error;
      $i++;
  
      my $tid_msg = '';
      if ( defined &threads::tid ) {
          my $tid = threads->tid;
          $tid_msg = " thread $tid" if $tid;
      }
  
      my %i = caller_info($i);
      return "$err at $i{file} line $i{line}$tid_msg\.\n";
  }
  
  sub short_error_loc {
      # You have to create your (hash)ref out here, rather than defaulting it
      # inside trusts *on a lexical*, as you want it to persist across calls.
      # (You can default it on $_[2], but that gets messy)
      my $cache = {};
      my $i     = 1;
      my $lvl   = $CarpLevel;
      {
          my $cgc = _cgc();
          my $called = $cgc ? $cgc->($i) : caller($i);
          $i++;
          my $caller = $cgc ? $cgc->($i) : caller($i);
  
          if (!defined($caller)) {
              my @caller = $cgc ? $cgc->($i) : caller($i);
              if (@caller) {
                  # if there's no package but there is other caller info, then
                  # the package has been deleted - treat this as a valid package
                  # in this case
                  redo if defined($called) && $CarpInternal{$called};
                  redo unless 0 > --$lvl;
                  last;
              }
              else {
                  return 0;
              }
          }
          redo if $Internal{$caller};
          redo if $CarpInternal{$caller};
          redo if $CarpInternal{$called};
          redo if trusts( $called, $caller, $cache );
          redo if trusts( $caller, $called, $cache );
          redo unless 0 > --$lvl;
      }
      return $i - 1;
  }
  
  sub shortmess_heavy {
      return longmess_heavy(@_) if $Verbose;
      return @_ if ref( $_[0] );    # don't break references as exceptions
      my $i = short_error_loc();
      if ($i) {
          ret_summary( $i, @_ );
      }
      else {
          longmess_heavy(@_);
      }
  }
  
  # If a string is too long, trims it with ...
  sub str_len_trim {
      my $str = shift;
      my $max = shift || 0;
      if ( 2 < $max and $max < length($str) ) {
          substr( $str, $max - 3 ) = '...';
      }
      return $str;
  }
  
  # Takes two packages and an optional cache.  Says whether the
  # first inherits from the second.
  #
  # Recursive versions of this have to work to avoid certain
  # possible endless loops, and when following long chains of
  # inheritance are less efficient.
  sub trusts {
      my $child  = shift;
      my $parent = shift;
      my $cache  = shift;
      my ( $known, $partial ) = get_status( $cache, $child );
  
      # Figure out consequences until we have an answer
      while ( @$partial and not exists $known->{$parent} ) {
          my $anc = shift @$partial;
          next if exists $known->{$anc};
          $known->{$anc}++;
          my ( $anc_knows, $anc_partial ) = get_status( $cache, $anc );
          my @found = keys %$anc_knows;
          @$known{@found} = ();
          push @$partial, @$anc_partial;
      }
      return exists $known->{$parent};
  }
  
  # Takes a package and gives a list of those trusted directly
  sub trusts_directly {
      my $class = shift;
      no strict 'refs';
      my $stash = \%{"$class\::"};
      for my $var (qw/ CARP_NOT ISA /) {
          # Don't try using the variable until we know it exists,
          # to avoid polluting the caller's namespace.
          if ( $stash->{$var} && *{$stash->{$var}}{ARRAY} && @{$stash->{$var}} ) {
             return @{$stash->{$var}}
          }
      }
      return;
  }
  
  if(!defined($warnings::VERSION) ||
  	do { no warnings "numeric"; $warnings::VERSION < 1.03 }) {
      # Very old versions of warnings.pm import from Carp.  This can go
      # wrong due to the circular dependency.  If Carp is invoked before
      # warnings, then Carp starts by loading warnings, then warnings
      # tries to import from Carp, and gets nothing because Carp is in
      # the process of loading and hasn't defined its import method yet.
      # So we work around that by manually exporting to warnings here.
      no strict "refs";
      *{"warnings::$_"} = \&$_ foreach @EXPORT;
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  Carp - alternative warn and die for modules
  
  =head1 SYNOPSIS
  
      use Carp;
  
      # warn user (from perspective of caller)
      carp "string trimmed to 80 chars";
  
      # die of errors (from perspective of caller)
      croak "We're outta here!";
  
      # die of errors with stack backtrace
      confess "not implemented";
  
      # cluck, longmess and shortmess not exported by default
      use Carp qw(cluck longmess shortmess);
      cluck "This is how we got here!";
      $long_message   = longmess( "message from cluck() or confess()" );
      $short_message  = shortmess( "message from carp() or croak()" );
  
  =head1 DESCRIPTION
  
  The Carp routines are useful in your own modules because
  they act like C<die()> or C<warn()>, but with a message which is more
  likely to be useful to a user of your module.  In the case of
  C<cluck()> and C<confess()>, that context is a summary of every
  call in the call-stack; C<longmess()> returns the contents of the error
  message.
  
  For a shorter message you can use C<carp()> or C<croak()> which report the
  error as being from where your module was called.  C<shortmess()> returns the
  contents of this error message.  There is no guarantee that that is where the
  error was, but it is a good educated guess.
  
  C<Carp> takes care not to clobber the status variables C<$!> and C<$^E>
  in the course of assembling its error messages.  This means that a
  C<$SIG{__DIE__}> or C<$SIG{__WARN__}> handler can capture the error
  information held in those variables, if it is required to augment the
  error message, and if the code calling C<Carp> left useful values there.
  Of course, C<Carp> can't guarantee the latter.
  
  You can also alter the way the output and logic of C<Carp> works, by
  changing some global variables in the C<Carp> namespace. See the
  section on C<GLOBAL VARIABLES> below.
  
  Here is a more complete description of how C<carp> and C<croak> work.
  What they do is search the call-stack for a function call stack where
  they have not been told that there shouldn't be an error.  If every
  call is marked safe, they give up and give a full stack backtrace
  instead.  In other words they presume that the first likely looking
  potential suspect is guilty.  Their rules for telling whether
  a call shouldn't generate errors work as follows:
  
  =over 4
  
  =item 1.
  
  Any call from a package to itself is safe.
  
  =item 2.
  
  Packages claim that there won't be errors on calls to or from
  packages explicitly marked as safe by inclusion in C<@CARP_NOT>, or
  (if that array is empty) C<@ISA>.  The ability to override what
  @ISA says is new in 5.8.
  
  =item 3.
  
  The trust in item 2 is transitive.  If A trusts B, and B
  trusts C, then A trusts C.  So if you do not override C<@ISA>
  with C<@CARP_NOT>, then this trust relationship is identical to,
  "inherits from".
  
  =item 4.
  
  Any call from an internal Perl module is safe.  (Nothing keeps
  user modules from marking themselves as internal to Perl, but
  this practice is discouraged.)
  
  =item 5.
  
  Any call to Perl's warning system (eg Carp itself) is safe.
  (This rule is what keeps it from reporting the error at the
  point where you call C<carp> or C<croak>.)
  
  =item 6.
  
  C<$Carp::CarpLevel> can be set to skip a fixed number of additional
  call levels.  Using this is not recommended because it is very
  difficult to get it to behave correctly.
  
  =back
  
  =head2 Forcing a Stack Trace
  
  As a debugging aid, you can force Carp to treat a croak as a confess
  and a carp as a cluck across I<all> modules. In other words, force a
  detailed stack trace to be given.  This can be very helpful when trying
  to understand why, or from where, a warning or error is being generated.
  
  This feature is enabled by 'importing' the non-existent symbol
  'verbose'. You would typically enable it by saying
  
      perl -MCarp=verbose script.pl
  
  or by including the string C<-MCarp=verbose> in the PERL5OPT
  environment variable.
  
  Alternately, you can set the global variable C<$Carp::Verbose> to true.
  See the C<GLOBAL VARIABLES> section below.
  
  =head2 Stack Trace formatting
  
  At each stack level, the subroutine's name is displayed along with
  its parameters.  For simple scalars, this is sufficient.  For complex
  data types, such as objects and other references, this can simply
  display C<'HASH(0x1ab36d8)'>.
  
  Carp gives two ways to control this.
  
  =over 4
  
  =item 1.
  
  For objects, a method, C<CARP_TRACE>, will be called, if it exists.  If
  this method doesn't exist, or it recurses into C<Carp>, or it otherwise
  throws an exception, this is skipped, and Carp moves on to the next option,
  otherwise checking stops and the string returned is used.  It is recommended
  that the object's type is part of the string to make debugging easier.
  
  =item 2.
  
  For any type of reference, C<$Carp::RefArgFormatter> is checked (see below).
  This variable is expected to be a code reference, and the current parameter
  is passed in.  If this function doesn't exist (the variable is undef), or
  it recurses into C<Carp>, or it otherwise throws an exception, this is
  skipped, and Carp moves on to the next option, otherwise checking stops
  and the string returned is used.
  
  =item 3.
  
  Otherwise, if neither C<CARP_TRACE> nor C<$Carp::RefArgFormatter> is
  available, stringify the value ignoring any overloading.
  
  =back
  
  =head1 GLOBAL VARIABLES
  
  =head2 $Carp::MaxEvalLen
  
  This variable determines how many characters of a string-eval are to
  be shown in the output. Use a value of C<0> to show all text.
  
  Defaults to C<0>.
  
  =head2 $Carp::MaxArgLen
  
  This variable determines how many characters of each argument to a
  function to print. Use a value of C<0> to show the full length of the
  argument.
  
  Defaults to C<64>.
  
  =head2 $Carp::MaxArgNums
  
  This variable determines how many arguments to each function to show.
  Use a value of C<0> to show all arguments to a function call.
  
  Defaults to C<8>.
  
  =head2 $Carp::Verbose
  
  This variable makes C<carp()> and C<croak()> generate stack backtraces
  just like C<cluck()> and C<confess()>.  This is how C<use Carp 'verbose'>
  is implemented internally.
  
  Defaults to C<0>.
  
  =head2 $Carp::RefArgFormatter
  
  This variable sets a general argument formatter to display references.
  Plain scalars and objects that implement C<CARP_TRACE> will not go through
  this formatter.  Calling C<Carp> from within this function is not supported.
  
  local $Carp::RefArgFormatter = sub {
      require Data::Dumper;
      Data::Dumper::Dump($_[0]); # not necessarily safe
  };
  
  =head2 @CARP_NOT
  
  This variable, I<in your package>, says which packages are I<not> to be
  considered as the location of an error. The C<carp()> and C<cluck()>
  functions will skip over callers when reporting where an error occurred.
  
  NB: This variable must be in the package's symbol table, thus:
  
      # These work
      our @CARP_NOT; # file scope
      use vars qw(@CARP_NOT); # package scope
      @My::Package::CARP_NOT = ... ; # explicit package variable
  
      # These don't work
      sub xyz { ... @CARP_NOT = ... } # w/o declarations above
      my @CARP_NOT; # even at top-level
  
  Example of use:
  
      package My::Carping::Package;
      use Carp;
      our @CARP_NOT;
      sub bar     { .... or _error('Wrong input') }
      sub _error  {
          # temporary control of where'ness, __PACKAGE__ is implicit
          local @CARP_NOT = qw(My::Friendly::Caller);
          carp(@_)
      }
  
  This would make C<Carp> report the error as coming from a caller not
  in C<My::Carping::Package>, nor from C<My::Friendly::Caller>.
  
  Also read the L</DESCRIPTION> section above, about how C<Carp> decides
  where the error is reported from.
  
  Use C<@CARP_NOT>, instead of C<$Carp::CarpLevel>.
  
  Overrides C<Carp>'s use of C<@ISA>.
  
  =head2 %Carp::Internal
  
  This says what packages are internal to Perl.  C<Carp> will never
  report an error as being from a line in a package that is internal to
  Perl.  For example:
  
      $Carp::Internal{ (__PACKAGE__) }++;
      # time passes...
      sub foo { ... or confess("whatever") };
  
  would give a full stack backtrace starting from the first caller
  outside of __PACKAGE__.  (Unless that package was also internal to
  Perl.)
  
  =head2 %Carp::CarpInternal
  
  This says which packages are internal to Perl's warning system.  For
  generating a full stack backtrace this is the same as being internal
  to Perl, the stack backtrace will not start inside packages that are
  listed in C<%Carp::CarpInternal>.  But it is slightly different for
  the summary message generated by C<carp> or C<croak>.  There errors
  will not be reported on any lines that are calling packages in
  C<%Carp::CarpInternal>.
  
  For example C<Carp> itself is listed in C<%Carp::CarpInternal>.
  Therefore the full stack backtrace from C<confess> will not start
  inside of C<Carp>, and the short message from calling C<croak> is
  not placed on the line where C<croak> was called.
  
  =head2 $Carp::CarpLevel
  
  This variable determines how many additional call frames are to be
  skipped that would not otherwise be when reporting where an error
  occurred on a call to one of C<Carp>'s functions.  It is fairly easy
  to count these call frames on calls that generate a full stack
  backtrace.  However it is much harder to do this accounting for calls
  that generate a short message.  Usually people skip too many call
  frames.  If they are lucky they skip enough that C<Carp> goes all of
  the way through the call stack, realizes that something is wrong, and
  then generates a full stack backtrace.  If they are unlucky then the
  error is reported from somewhere misleading very high in the call
  stack.
  
  Therefore it is best to avoid C<$Carp::CarpLevel>.  Instead use
  C<@CARP_NOT>, C<%Carp::Internal> and C<%Carp::CarpInternal>.
  
  Defaults to C<0>.
  
  =head1 BUGS
  
  The Carp routines don't handle exception objects currently.
  If called with a first argument that is a reference, they simply
  call die() or warn(), as appropriate.
  
  Some of the Carp code assumes that Perl's basic character encoding is
  ASCII, and will go wrong on an EBCDIC platform.
  
  =head1 SEE ALSO
  
  L<Carp::Always>,
  L<Carp::Clan>
  
  =head1 AUTHOR
  
  The Carp module first appeared in Larry Wall's perl 5.000 distribution.
  Since then it has been modified by several of the perl 5 porters.
  Andrew Main (Zefram) <zefram@fysh.org> divested Carp into an independent
  distribution.
  
  =head1 COPYRIGHT
  
  Copyright (C) 1994-2013 Larry Wall
  
  Copyright (C) 2011, 2012, 2013 Andrew Main (Zefram) <zefram@fysh.org>
  
  =head1 LICENSE
  
  This module is free software; you can redistribute it and/or modify it
  under the same terms as Perl itself.
CARP

$fatpacked{"Carp/Heavy.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CARP_HEAVY';
  package Carp::Heavy;
  
  use Carp ();
  
  our $VERSION = '1.3301';
  
  my $cv = defined($Carp::VERSION) ? $Carp::VERSION : "undef";
  if($cv ne $VERSION) {
  	die "Version mismatch between Carp $cv ($INC{q(Carp.pm)}) and Carp::Heavy $VERSION ($INC{q(Carp/Heavy.pm)}).  Did you alter \@INC after Carp was loaded?\n";
  }
  
  1;
  
  # Most of the machinery of Carp used to be here.
  # It has been moved in Carp.pm now, but this placeholder remains for
  # the benefit of modules that like to preload Carp::Heavy directly.
  # This must load Carp, because some modules rely on the historical
  # behaviour of Carp::Heavy loading Carp.
CARP_HEAVY

$fatpacked{"IO/String.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IO_STRING';
  package IO::String;
  
  # Copyright 1998-2005 Gisle Aas.
  #
  # This library is free software; you can redistribute it and/or
  # modify it under the same terms as Perl itself.
  
  require 5.005_03;
  use strict;
  use vars qw($VERSION $DEBUG $IO_CONSTANTS);
  $VERSION = "1.08";  # $Date: 2005/12/05 12:00:47 $
  
  use Symbol ();
  
  sub new
  {
      my $class = shift;
      my $self = bless Symbol::gensym(), ref($class) || $class;
      tie *$self, $self;
      $self->open(@_);
      return $self;
  }
  
  sub open
  {
      my $self = shift;
      return $self->new(@_) unless ref($self);
  
      if (@_) {
  	my $bufref = ref($_[0]) ? $_[0] : \$_[0];
  	$$bufref = "" unless defined $$bufref;
  	*$self->{buf} = $bufref;
      }
      else {
  	my $buf = "";
  	*$self->{buf} = \$buf;
      }
      *$self->{pos} = 0;
      *$self->{lno} = 0;
      return $self;
  }
  
  sub pad
  {
      my $self = shift;
      my $old = *$self->{pad};
      *$self->{pad} = substr($_[0], 0, 1) if @_;
      return "\0" unless defined($old) && length($old);
      return $old;
  }
  
  sub dump
  {
      require Data::Dumper;
      my $self = shift;
      print Data::Dumper->Dump([$self], ['*self']);
      print Data::Dumper->Dump([*$self{HASH}], ['$self{HASH}']);
      return;
  }
  
  sub TIEHANDLE
  {
      print "TIEHANDLE @_\n" if $DEBUG;
      return $_[0] if ref($_[0]);
      my $class = shift;
      my $self = bless Symbol::gensym(), $class;
      $self->open(@_);
      return $self;
  }
  
  sub DESTROY
  {
      print "DESTROY @_\n" if $DEBUG;
  }
  
  sub close
  {
      my $self = shift;
      delete *$self->{buf};
      delete *$self->{pos};
      delete *$self->{lno};
      undef *$self if $] eq "5.008";  # workaround for some bug
      return 1;
  }
  
  sub opened
  {
      my $self = shift;
      return defined *$self->{buf};
  }
  
  sub binmode
  {
      my $self = shift;
      return 1 unless @_;
      # XXX don't know much about layers yet :-(
      return 0;
  }
  
  sub getc
  {
      my $self = shift;
      my $buf;
      return $buf if $self->read($buf, 1);
      return undef;
  }
  
  sub ungetc
  {
      my $self = shift;
      $self->setpos($self->getpos() - 1);
      return 1;
  }
  
  sub eof
  {
      my $self = shift;
      return length(${*$self->{buf}}) <= *$self->{pos};
  }
  
  sub print
  {
      my $self = shift;
      if (defined $\) {
  	if (defined $,) {
  	    $self->write(join($,, @_).$\);
  	}
  	else {
  	    $self->write(join("",@_).$\);
  	}
      }
      else {
  	if (defined $,) {
  	    $self->write(join($,, @_));
  	}
  	else {
  	    $self->write(join("",@_));
  	}
      }
      return 1;
  }
  *printflush = \*print;
  
  sub printf
  {
      my $self = shift;
      print "PRINTF(@_)\n" if $DEBUG;
      my $fmt = shift;
      $self->write(sprintf($fmt, @_));
      return 1;
  }
  
  
  my($SEEK_SET, $SEEK_CUR, $SEEK_END);
  
  sub _init_seek_constants
  {
      if ($IO_CONSTANTS) {
  	require IO::Handle;
  	$SEEK_SET = &IO::Handle::SEEK_SET;
  	$SEEK_CUR = &IO::Handle::SEEK_CUR;
  	$SEEK_END = &IO::Handle::SEEK_END;
      }
      else {
  	$SEEK_SET = 0;
  	$SEEK_CUR = 1;
  	$SEEK_END = 2;
      }
  }
  
  
  sub seek
  {
      my($self,$off,$whence) = @_;
      my $buf = *$self->{buf} || return 0;
      my $len = length($$buf);
      my $pos = *$self->{pos};
  
      _init_seek_constants() unless defined $SEEK_SET;
  
      if    ($whence == $SEEK_SET) { $pos = $off }
      elsif ($whence == $SEEK_CUR) { $pos += $off }
      elsif ($whence == $SEEK_END) { $pos = $len + $off }
      else                         { die "Bad whence ($whence)" }
      print "SEEK(POS=$pos,OFF=$off,LEN=$len)\n" if $DEBUG;
  
      $pos = 0 if $pos < 0;
      $self->truncate($pos) if $pos > $len;  # extend file
      *$self->{pos} = $pos;
      return 1;
  }
  
  sub pos
  {
      my $self = shift;
      my $old = *$self->{pos};
      if (@_) {
  	my $pos = shift || 0;
  	my $buf = *$self->{buf};
  	my $len = $buf ? length($$buf) : 0;
  	$pos = $len if $pos > $len;
  	*$self->{pos} = $pos;
      }
      return $old;
  }
  
  sub getpos { shift->pos; }
  
  *sysseek = \&seek;
  *setpos  = \&pos;
  *tell    = \&getpos;
  
  
  
  sub getline
  {
      my $self = shift;
      my $buf  = *$self->{buf} || return;
      my $len  = length($$buf);
      my $pos  = *$self->{pos};
      return if $pos >= $len;
  
      unless (defined $/) {  # slurp
  	*$self->{pos} = $len;
  	return substr($$buf, $pos);
      }
  
      unless (length $/) {  # paragraph mode
  	# XXX slow&lazy implementation using getc()
  	my $para = "";
  	my $eol = 0;
  	my $c;
  	while (defined($c = $self->getc)) {
  	    if ($c eq "\n") {
  		$eol++;
  		next if $eol > 2;
  	    }
  	    elsif ($eol > 1) {
  		$self->ungetc($c);
  		last;
  	    }
  	    else {
  		$eol = 0;
  	    }
  	    $para .= $c;
  	}
  	return $para;   # XXX wantarray
      }
  
      my $idx = index($$buf,$/,$pos);
      if ($idx < 0) {
  	# return rest of it
  	*$self->{pos} = $len;
  	$. = ++ *$self->{lno};
  	return substr($$buf, $pos);
      }
      $len = $idx - $pos + length($/);
      *$self->{pos} += $len;
      $. = ++ *$self->{lno};
      return substr($$buf, $pos, $len);
  }
  
  sub getlines
  {
      die "getlines() called in scalar context\n" unless wantarray;
      my $self = shift;
      my($line, @lines);
      push(@lines, $line) while defined($line = $self->getline);
      return @lines;
  }
  
  sub READLINE
  {
      goto &getlines if wantarray;
      goto &getline;
  }
  
  sub input_line_number
  {
      my $self = shift;
      my $old = *$self->{lno};
      *$self->{lno} = shift if @_;
      return $old;
  }
  
  sub truncate
  {
      my $self = shift;
      my $len = shift || 0;
      my $buf = *$self->{buf};
      if (length($$buf) >= $len) {
  	substr($$buf, $len) = '';
  	*$self->{pos} = $len if $len < *$self->{pos};
      }
      else {
  	$$buf .= ($self->pad x ($len - length($$buf)));
      }
      return 1;
  }
  
  sub read
  {
      my $self = shift;
      my $buf = *$self->{buf};
      return undef unless $buf;
  
      my $pos = *$self->{pos};
      my $rem = length($$buf) - $pos;
      my $len = $_[1];
      $len = $rem if $len > $rem;
      return undef if $len < 0;
      if (@_ > 2) { # read offset
  	substr($_[0],$_[2]) = substr($$buf, $pos, $len);
      }
      else {
  	$_[0] = substr($$buf, $pos, $len);
      }
      *$self->{pos} += $len;
      return $len;
  }
  
  sub write
  {
      my $self = shift;
      my $buf = *$self->{buf};
      return unless $buf;
  
      my $pos = *$self->{pos};
      my $slen = length($_[0]);
      my $len = $slen;
      my $off = 0;
      if (@_ > 1) {
  	$len = $_[1] if $_[1] < $len;
  	if (@_ > 2) {
  	    $off = $_[2] || 0;
  	    die "Offset outside string" if $off > $slen;
  	    if ($off < 0) {
  		$off += $slen;
  		die "Offset outside string" if $off < 0;
  	    }
  	    my $rem = $slen - $off;
  	    $len = $rem if $rem < $len;
  	}
      }
      substr($$buf, $pos, $len) = substr($_[0], $off, $len);
      *$self->{pos} += $len;
      return $len;
  }
  
  *sysread = \&read;
  *syswrite = \&write;
  
  sub stat
  {
      my $self = shift;
      return unless $self->opened;
      return 1 unless wantarray;
      my $len = length ${*$self->{buf}};
  
      return (
       undef, undef,  # dev, ino
       0666,          # filemode
       1,             # links
       $>,            # user id
       $),            # group id
       undef,         # device id
       $len,          # size
       undef,         # atime
       undef,         # mtime
       undef,         # ctime
       512,           # blksize
       int(($len+511)/512)  # blocks
      );
  }
  
  sub FILENO {
      return undef;   # XXX perlfunc says this means the file is closed
  }
  
  sub blocking {
      my $self = shift;
      my $old = *$self->{blocking} || 0;
      *$self->{blocking} = shift if @_;
      return $old;
  }
  
  my $notmuch = sub { return };
  
  *fileno    = $notmuch;
  *error     = $notmuch;
  *clearerr  = $notmuch; 
  *sync      = $notmuch;
  *flush     = $notmuch;
  *setbuf    = $notmuch;
  *setvbuf   = $notmuch;
  
  *untaint   = $notmuch;
  *autoflush = $notmuch;
  *fcntl     = $notmuch;
  *ioctl     = $notmuch;
  
  *GETC   = \&getc;
  *PRINT  = \&print;
  *PRINTF = \&printf;
  *READ   = \&read;
  *WRITE  = \&write;
  *SEEK   = \&seek;
  *TELL   = \&getpos;
  *EOF    = \&eof;
  *CLOSE  = \&close;
  *BINMODE = \&binmode;
  
  
  sub string_ref
  {
      my $self = shift;
      return *$self->{buf};
  }
  *sref = \&string_ref;
  
  1;
  
  __END__
  
  =head1 NAME
  
  IO::String - Emulate file interface for in-core strings
  
  =head1 SYNOPSIS
  
   use IO::String;
   $io = IO::String->new;
   $io = IO::String->new($var);
   tie *IO, 'IO::String';
  
   # read data
   <$io>;
   $io->getline;
   read($io, $buf, 100);
  
   # write data
   print $io "string\n";
   $io->print(@data);
   syswrite($io, $buf, 100);
  
   select $io;
   printf "Some text %s\n", $str;
  
   # seek
   $pos = $io->getpos;
   $io->setpos(0);        # rewind
   $io->seek(-30, -1);
   seek($io, 0, 0);
  
  =head1 DESCRIPTION
  
  The C<IO::String> module provides the C<IO::File> interface for in-core
  strings.  An C<IO::String> object can be attached to a string, and
  makes it possible to use the normal file operations for reading or
  writing data, as well as for seeking to various locations of the string.
  This is useful when you want to use a library module that only
  provides an interface to file handles on data that you have in a string
  variable.
  
  Note that perl-5.8 and better has built-in support for "in memory"
  files, which are set up by passing a reference instead of a filename
  to the open() call. The reason for using this module is that it
  makes the code backwards compatible with older versions of Perl.
  
  The C<IO::String> module provides an interface compatible with
  C<IO::File> as distributed with F<IO-1.20>, but the following methods
  are not available: new_from_fd, fdopen, format_write,
  format_page_number, format_lines_per_page, format_lines_left,
  format_name, format_top_name.
  
  The following methods are specific to the C<IO::String> class:
  
  =over 4
  
  =item $io = IO::String->new
  
  =item $io = IO::String->new( $string )
  
  The constructor returns a newly-created C<IO::String> object.  It
  takes an optional argument, which is the string to read from or write
  into.  If no $string argument is given, then an internal buffer
  (initially empty) is allocated.
  
  The C<IO::String> object returned is tied to itself.  This means
  that you can use most Perl I/O built-ins on it too: readline, <>, getc,
  print, printf, syswrite, sysread, close.
  
  =item $io->open
  
  =item $io->open( $string )
  
  Attaches an existing IO::String object to some other $string, or
  allocates a new internal buffer (if no argument is given).  The
  position is reset to 0.
  
  =item $io->string_ref
  
  Returns a reference to the string that is attached to
  the C<IO::String> object.  Most useful when you let the C<IO::String>
  create an internal buffer to write into.
  
  =item $io->pad
  
  =item $io->pad( $char )
  
  Specifies the padding to use if
  the string is extended by either the seek() or truncate() methods.  It
  is a single character and defaults to "\0".
  
  =item $io->pos
  
  =item $io->pos( $newpos )
  
  Yet another interface for reading and setting the current read/write
  position within the string (the normal getpos/setpos/tell/seek
  methods are also available).  The pos() method always returns the
  old position, and if you pass it an argument it sets the new
  position.
  
  There is (deliberately) a difference between the setpos() and seek()
  methods in that seek() extends the string (with the specified
  padding) if you go to a location past the end, whereas setpos()
  just snaps back to the end.  If truncate() is used to extend the string,
  then it works as seek().
  
  =back
  
  =head1 BUGS
  
  In Perl versions < 5.6, the TIEHANDLE interface was incomplete.
  If you use such a Perl, then seek(), tell(), eof(), fileno(), binmode() will
  not do anything on an C<IO::String> handle.  See L<perltie> for
  details.
  
  =head1 SEE ALSO
  
  L<IO::File>, L<IO::Stringy>, L<perlfunc/open>
  
  =head1 COPYRIGHT
  
  Copyright 1998-2005 Gisle Aas.
  
  This library is free software; you can redistribute it and/or
  modify it under the same terms as Perl itself.
  
  =cut
IO_STRING

$fatpacked{"Module/Locate.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_LOCATE';
  {
    package Module::Locate;
  
    use warnings;
    use 5.8.8;
  
    our $VERSION  = '1.79';
    our $Cache    = 0;
    our $Global   = 1;
  
    my $ident_re = qr{[_a-z]\w*}i;
    my $sep_re   = qr{'|::};
    our $PkgRe    = qr{\A(?:$ident_re(?:$sep_re$ident_re)*)\z};
  
    my @All      = qw(
      locate get_source acts_like_fh
      mod_to_path is_mod_loaded is_pkg_loaded
    );
  
    sub import {
      my $pkg = caller;
      my @args = @_[ 1 .. $#_ ];
      
      while(local $_ = shift @args) {
        *{ "$pkg\::$_" } = \&$_ and next
          if defined &$_;
  
        $Cache = shift @args, next
          if /^cache$/i;
  
        $Global = shift @args, next
          if /^global$/i;
  
        if(/^:all$/i) {
          *{ "$pkg\::$_" } = \&$_
            for @All;
          next;
        }
  
        warn("not in ".__PACKAGE__." import list: '$_'");
      }
    }
  
    use strict;
  
    use IO::File;
    use overload ();
    use Carp 'croak';
    use File::Spec::Functions 'catfile';
    
    sub get_source {
      my $pkg = $_[-1];
  
      my $f = locate($pkg);
  
      my $fh = ( acts_like_fh($f) ?
        $f
      :
        do { my $tmp = IO::File->new($f)
               or croak("invalid module '$pkg' [$f] - $!"); $tmp }
      );
  
      local $/;
      return <$fh>;
    }
    
    sub locate {
      my $pkg = $_[-1];
  
      croak("Undefined filename provided")
        unless defined $pkg;
        
      my $inc_path = mod_to_path($pkg);
  
      return $INC{$inc_path} if exists($INC{$inc_path}) && !wantarray;
  
      # On Windows the inc_path will use '/' for directory separator,
      # but when looking for a module, we need to use the OS's separator.
      my $partial_path = _mod_to_partial_path($pkg);
  
      my @paths;
  
      for(@INC) {
        if(ref $_) {
          my $ret = coderefs_in_INC($_, $inc_path);
  
          next
            unless defined $ret;
  
          croak("invalid \@INC subroutine return $ret")
            unless acts_like_fh($ret);
  
          return $ret;
        }
  
        my $fullpath = catfile($_, $partial_path);
        push(@paths, $fullpath) if -f $fullpath;
      }
  
      return unless @paths > 0;
  
      return wantarray ? @paths : $paths[0];
    }
  
    sub mod_to_path {
      my $pkg  = shift;
      my $path = $pkg;
  
      croak("Invalid package name '$pkg'")
        unless $pkg =~ $Module::Locate::PkgRe;
  
      # %INC always uses / as a directory separator, even on Windows
      $path =~ s!::!/!g;
      $path .= '.pm' unless $path =~ m!\.pm$!;
  
      return $path;
    }
  
    sub coderefs_in_INC {
      my($path, $c) = reverse @_;
  
      my $ret = ref($c) eq 'CODE' ?
        $c->( $c, $path )
      :
        ref($c) eq 'ARRAY' ?
          $c->[0]->( $c, $path )
        :
          UNIVERSAL::can($c, 'INC') ?
            $c->INC( $path )
          :
            warn("invalid reference in \@INC '$c'")
      ;
  
      return $ret;
    }
  
    sub acts_like_fh {
      no strict 'refs';
      return ( ref $_[0] and (
           ( ref $_[0] eq 'GLOB' and defined *{$_[0]}{IO} )
        or ( UNIVERSAL::isa($_[0], 'IO::Handle')          )
        or ( overload::Method($_[0], '<>')                )
      ) or ref \$_[0] eq 'GLOB' and defined *{$_[0]}{IO}  );
    }
  
    sub is_mod_loaded {
      my $mod  = shift;
      
      croak("Invalid package name '$mod'")
        unless $mod =~ $Module::Locate::PkgRe;
      
      ## it looks like %INC entries automagically use / as a separator
      my $path = join '/', split '::' => "$mod.pm";
  
      return (exists $INC{$path} && defined $INC{$path});
    }
  
    sub _mod_to_partial_path {
      my $package = shift;
  
      return catfile(split(/::/, $package)).'.pm';
    }
  
    sub is_pkg_loaded {
      my $pkg = shift;
  
      croak("Invalid package name '$pkg'")
        unless $pkg =~ $Module::Locate::PkgRe;
  
      my @tbls = map "${_}::", split('::' => $pkg);
      my $tbl  = \%main::;
      
      for(@tbls) {
        return unless exists $tbl->{$_};
        $tbl = $tbl->{$_};
      }
      
      return !!$pkg;
    }
  }
  
  q[ That better be make-up, and it better be good ];
  
  =pod
  
  =head1 NAME
  
  Module::Locate - locate modules in the same fashion as C<require> and C<use>
  
  =head1 SYNOPSIS
  
    use Module::Locate qw/ locate get_source /;
    
    add_plugin( locate "This::Module" );
    eval 'use strict; ' . get_source('legacy_code.plx');
  
  =head1 DESCRIPTION
  
  Using C<locate()>, return the path that C<require> would find for a given
  module or filename (it can also return a filehandle if a reference in C<@INC>
  has been used). This means you can test for the existence, or find the path
  for, modules without having to evaluate the code they contain.
  
  This module also comes with accompanying utility functions that are used within
  the module itself (except for C<get_source>) and are available for import.
  
  =head1 FUNCTIONS
  
  =over 4
  
  =item C<import>
  
  Given function names, the appropriate functions will be exported into the
  caller's package.
  
  If C<:all> is passed then all subroutines are exported.
  
  The B<Global> and B<Cache> options are no longer supported.
  See the BUGS section below.
  
  
  =item C<locate($module_name)>
  
  Given a module name as a string (in standard perl bareword format) locate the
  path of the module. If called in a scalar context the first path found will be
  returned, if called in a list context a list of paths where the module was
  found. Also, if references have been placed in C<@INC> then a filehandle will
  be returned, as defined in the C<require> documentation. An empty C<return> is
  used if the module couldn't be located.
  
  As of version C<1.7> a filename can also be provided to further mimic the lookup
  behaviour of C<require>/C<use>.
  
  =item C<get_source($module_name)>
  
  When provided with a package name, gets the path using C<locate()>.
  If C<locate()> returned a path, then the contents of that file are returned
  by C<get_source()> in a scalar.
  
  =item C<acts_like_fh>
  
  Given a scalar, check if it behaves like a filehandle. Firstly it checks if it
  is a bareword filehandle, then if it inherits from C<IO::Handle> and lastly if
  it overloads the C<E<lt>E<gt>> operator. If this is missing any other standard
  filehandle behaviour, please send me an e-mail.
  
  =item C<mod_to_path($module_name)>
  
  Given a module name,
  converts it to a relative path e.g C<Foo::Bar> would become C<Foo/Bar.pm>.
  
  Note that this path will always use '/' for the directory separator,
  even on Windows,
  as that's the format used in C<%INC>.
  
  =item C<is_mod_loaded($module_name)>
  
  Given a module name, return true if the module has been
  loaded (i.e exists in the C<%INC> hash).
  
  =item C<is_pkg_loaded($package_name)>
  
  Given a package name (like C<locate()>), check if the package has an existing
  symbol table loaded (checks by walking the C<%main::> stash).
  
  =back
  
  =head1 SEE ALSO
  
  A review of modules that can be used to get the path (and often other information)
  for one or more modules: L<http://neilb.org/reviews/module-path.html>.
  
  L<App::Module::Locate> and L<mlocate>.
  
  =head1 REPOSITORY
  
  L<https://github.com/neilbowers/Module-Locate>
  
  =head1 BUGS
  
  In previous versions of this module, if you specified C<Global =E<gt> 1>
  when use'ing this module,
  then looking up a module's path would update C<%INC>,
  even if the module hadn't actually been loaded (yet).
  This meant that if you subsequently tried to load the module,
  it would wrongly not be loaded.
  
  Bugs are tracked using RT (bug you can also raise Github issues if you prefer):
  
  L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Module-Locate>
  
  =head1 AUTHOR
  
  Dan Brook C<< <cpan@broquaint.com> >>
  
  =head1 LICENSE
  
  This is free software; you can redistribute it and/or modify it under the same terms as
  Perl itself.
  
  =cut
MODULE_LOCATE

$fatpacked{"PPI.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI';
  package PPI;
  
  # See POD at end for documentation
  
  use 5.006;
  use strict;
  
  # Set the version for CPAN
  use vars qw{$VERSION $XS_COMPATIBLE @XS_EXCLUDE};
  BEGIN {
  	$VERSION       = '1.215';
  	$XS_COMPATIBLE = '0.845';
  	@XS_EXCLUDE    = ();
  }
  
  # Load everything
  use PPI::Util                 ();
  use PPI::Exception            ();
  use PPI::Element              ();
  use PPI::Token                ();
  use PPI::Statement            ();
  use PPI::Structure            ();
  use PPI::Document             ();
  use PPI::Document::File       ();
  use PPI::Document::Fragment   ();
  use PPI::Document::Normalized ();
  use PPI::Normal               ();
  use PPI::Tokenizer            ();
  use PPI::Lexer                ();
  
  # If it is installed, load in PPI::XS
  unless ( $PPI::XS_DISABLE ) {
  	eval { require PPI::XS };
  	# Only ignore the failure to load PPI::XS if not installed
  	die if $@ && $@ !~ /^Can't locate .*? at /;
  }
  
  1;
  
  __END__
  
  =pod
  
  =head1 NAME
  
  PPI - Parse, Analyze and Manipulate Perl (without perl)
  
  =head1 SYNOPSIS
  
    use PPI;
    
    # Create a new empty document
    my $Document = PPI::Document->new;
    
    # Create a document from source
    $Document = PPI::Document->new(\'print "Hello World!\n"');
    
    # Load a Document from a file
    $Document = PPI::Document->new('Module.pm');
    
    # Does it contain any POD?
    if ( $Document->find_any('PPI::Token::Pod') ) {
        print "Module contains POD\n";
    }
    
    # Get the name of the main package
    $pkg = $Document->find_first('PPI::Statement::Package')->namespace;
    
    # Remove all that nasty documentation
    $Document->prune('PPI::Token::Pod');
    $Document->prune('PPI::Token::Comment');
    
    # Save the file
    $Document->save('Module.pm.stripped');
  
  =head1 DESCRIPTION
  
  =head2 About this Document
  
  This is the PPI manual. It describes its reason for existing, its general
  structure, its use, an overview of the API, and provides a few
  implementation samples.
  
  =head2 Background
  
  The ability to read, and manipulate Perl (the language) programmatically
  other than with perl (the application) was one that caused difficulty
  for a long time.
  
  The cause of this problem was Perl's complex and dynamic grammar.
  Although there is typically not a huge diversity in the grammar of most
  Perl code, certain issues cause large problems when it comes to parsing.
  
  Indeed, quite early in Perl's history Tom Christenson introduced the Perl
  community to the quote I<"Nothing but perl can parse Perl">, or as it is
  more often stated now as a truism:
  
  B<"Only perl can parse Perl">
  
  One example of the sorts of things the prevent Perl being easily parsed are
  function signatures, as demonstrated by the following.
  
    @result = (dothis $foo, $bar);
    
    # Which of the following is it equivalent to?
    @result = (dothis($foo), $bar);
    @result = dothis($foo, $bar);
  
  The first line above can be interpreted in two different ways, depending
  on whether the C<&dothis> function is expecting one argument, or two,
  or several.
  
  A "code parser" (something that parses for the purpose of execution) such
  as perl needs information that is not found in the immediate vicinity of
  the statement being parsed.
  
  The information might not just be elsewhere in the file, it might not even be
  in the same file at all. It might also not be able to determine this
  information without the prior execution of a C<BEGIN {}> block, or the
  loading and execution of one or more external modules. Or worse the &dothis
  function may not even have been written yet.
  
  B<When parsing Perl as code, you must also execute it>
  
  Even perl itself never really fully understands the structure of the source
  code after and indeed B<as> it processes it, and in that sense doesn't
  "parse" Perl source into anything remotely like a structured document.
  This makes it of no real use for any task that needs to treat the source
  code as a document, and do so reliably and robustly.
  
  For more information on why it is impossible to parse perl, see Randal
  Schwartz's seminal response to the question of "Why can't you parse Perl".
  
  L<http://www.perlmonks.org/index.pl?node_id=44722>
  
  The purpose of PPI is B<not> to parse Perl I<Code>, but to parse Perl
  I<Documents>. By treating the problem this way, we are able to parse a
  single file containing Perl source code "isolated" from any other
  resources, such as libraries upon which the code may depend, and
  without needing to run an instance of perl alongside or inside the parser.
  
  Historically, using an embedded perl parser was widely considered to be
  the most likely avenue for finding a solution to C<Parse::Perl>. It was
  investigated from time to time and attempts have generally failed or
  suffered from sufficiently bad corner cases that they were abandoned.
  
  =head2 What Does PPI Stand For?
  
  C<PPI> is an acronym for the longer original module name
  C<Parse::Perl::Isolated>. And in the spirit or the silly acronym games
  played by certain unnamed Open Source projects you may have I<hurd> of,
  it also a reverse backronym of "I Parse Perl".
  
  Of course, I could just be lying and have just made that second bit up
  10 minutes before the release of PPI 1.000. Besides, B<all> the cool
  Perl packages have TLAs (Three Letter Acronyms). It's a rule or something.
  
  Why don't you just think of it as the B<Perl Parsing Interface> for simplicity.
  
  The original name was shortened to prevent the author (and you the users)
  from contracting RSI by having to type crazy things like
  C<Parse::Perl::Isolated::Token::QuoteLike::Backtick> 100 times a day.
  
  In acknowledgment that someone may some day come up with a valid solution
  for the grammar problem it was decided at the commencement of the project
  to leave the C<Parse::Perl> namespace free for any such effort.
  
  Since that time I've been able to prove to my own satisfaction that it
  B<is> truly impossible to accurately parse Perl as both code and document
  at once. For the academics, parsing Perl suffers from the "Halting Problem".
  
  With this in mind C<Parse::Perl> has now been co-opted as the title for
  the SourceForge project that publishes PPI and a large collection of other
  applications and modules related to the (document) parsing of Perl source
  code.
  
  You can find this project at L<http://sf.net/projects/parseperl>,
  however we no longer use the SourceForge CVS server.  Instead, the
  current development version of PPI is available via SVN at
  L<http://svn.ali.as/cpan/trunk/PPI/>.
  
  =head2 Why Parse Perl?
  
  Once you can accept that we will never be able to parse Perl well enough
  to meet the standards of things that treat Perl as code, it is worth
  re-examining C<why> we want to "parse" Perl at all.
  
  What are the things that people might want a "Perl parser" for.
  
  =over 4
  
  =item Documentation
  
  Analyzing the contents of a Perl document to automatically generate
  documentation, in parallel to, or as a replacement for, POD documentation.
  
  Allow an indexer to to locate and process all the comments and
  documentation from code for "full text search" applications.
  
  =item Structural and Quality Analysis
  
  Determine quality or other metrics across a body of code, and identify
  situations relating to particular phrases, techniques or locations.
  
  Index functions, variables and packages within Perl code, and doing search
  and graph (in the node/edge sense) analysis of large code bases.
  
  =item Refactoring
  
  Make structural, syntax, or other changes to code in an automated manner,
  either independently or in assistance to an editor. This sort of task list
  includes backporting, forward porting, partial evaluation, "improving" code,
  or whatever. All the sort of things you'd want from a L<Perl::Editor>.
  
  =item Layout
  
  Change the layout of code without changing its meaning. This includes
  techniques such as tidying (like L<perltidy>), obfuscation, compressing and
  "squishing", or to implement formatting preferences or policies.
  
  =item Presentation
  
  This includes methods of improving the presentation of code, without changing
  the content of the code. Modify, improve, syntax colour etc the presentation
  of a Perl document. Generating "IntelliText"-like functions.
  
  =back
  
  If we treat this as a baseline for the sort of things we are going to have
  to build on top of Perl, then it becomes possible to identify a standard
  for how good a Perl parser needs to be.
  
  =head2 How good is Good Enough(TM)
  
  PPI seeks to be good enough to achieve all of the above tasks, or to provide
  a sufficiently good API on which to allow others to implement modules in
  these and related areas.
  
  However, there are going to be limits to this process. Because PPI cannot
  adapt to changing grammars, any code written using source filters should not
  be assumed to be parsable.
  
  At one extreme, this includes anything munged by L<Acme::Bleach>, as well
  as (arguably) more common cases like L<Switch>. We do not pretend to be
  able to always parse code using these modules, although as long as it still
  follows a format that looks like Perl syntax, it may be possible to extend
  the lexer to handle them.
  
  The ability to extend PPI to handle lexical additions to the language is on
  the drawing board to be done some time post-1.0
  
  The goal for success was originally to be able to successfully parse 99% of
  all Perl documents contained in CPAN. This means the entire file in each
  case.
  
  PPI has succeeded in this goal far beyond the expectations of even the
  author. At time of writing there are only 28 non-Acme Perl modules in CPAN
  that PPI is incapable of parsing. Most of these are so badly broken they
  do not compile as Perl code anyway.
  
  So unless you are actively going out of your way to break PPI, you should
  expect that it will handle your code just fine.
  
  =head2 Internationalisation
  
  PPI provides partial support for internationalisation and localisation.
  
  Specifically, it allows the use characters from the Latin-1 character
  set to be used in quotes, comments, and POD. Primarily, this covers
  languages from Europe and South America.
  
  PPI does B<not> currently provide support for Unicode, although there
  is an initial implementation available in a development branch from
  CVS.
  
  If you need Unicode support, and would like to help stress test the
  Unicode support so we can move it to the main branch and enable it
  in the main release should contact the author. (contact details below)
  
  =head2 Round Trip Safe
  
  When PPI parses a file it builds B<everything> into the model, including
  whitespace. This is needed in order to make the Document fully "Round Trip"
  safe.
  
  The general concept behind a "Round Trip" parser is that it knows what it
  is parsing is somewhat uncertain, and so B<expects> to get things wrong
  from time to time. In the cases where it parses code wrongly the tree
  will serialize back out to the same string of code that was read in,
  repairing the parser's mistake as it heads back out to the file.
  
  The end result is that if you parse in a file and serialize it back out
  without changing the tree, you are guaranteed to get the same file you
  started with. PPI does this correctly and reliably for 100% of all known
  cases.
  
  B<What goes in, will come out. Every time.>
  
  The one minor exception at this time is that if the newlines for your file
  are wrong (meaning not matching the platform newline format), PPI will
  localise them for you. (It isn't to be convenient, supporting
  arbitrary newlines would make some of the code more complicated)
  
  Better control of the newline type is on the wish list though, and
  anyone wanting to help out is encouraged to contact the author.
  
  =head1 IMPLEMENTATION
  
  =head2 General Layout
  
  PPI is built upon two primary "parsing" components, L<PPI::Tokenizer>
  and L<PPI::Lexer>, and a large tree of about 50 classes which implement
  the various the I<Perl Document Object Model> (PDOM).
  
  The PDOM is conceptually similar in style and intent to the regular DOM or
  other code Abstract Syntax Trees (ASTs), but contains some differences
  to handle perl-specific cases, and to assist in treating the code as a
  document. Please note that it is B<not> an implementation of the official
  Document Object Model specification, only somewhat similar to it.
  
  On top of the Tokenizer, Lexer and the classes of the PDOM, sit a number
  of classes intended to make life a little easier when dealing with PDOM
  trees.
  
  Both the major parsing components were hand-coded from scratch with only
  plain Perl code and a few small utility modules. There are no grammar or
  patterns mini-languages, no YACC or LEX style tools and only a small number
  of regular expressions.
  
  This is primarily because of the sheer volume of accumulated cruft that
  exists in Perl. Not even perl itself is capable of parsing Perl documents
  (remember, it just parses and executes it as code).
  
  As a result, PPI needed to be cruftier than perl itself. Feel free to
  shudder at this point, and hope you never have to understand the Tokenizer
  codebase. Speaking of which...
  
  =head2 The Tokenizer
  
  The Tokenizer takes source code and converts it into a series of tokens. It
  does this using a slow but thorough character by character manual process,
  rather than using a pattern system or complex regexes.
  
  Or at least it does so conceptually. If you were to actually trace the code
  you would find it's not truly character by character due to a number of
  regexps and optimisations throughout the code. This lets the Tokenizer
  "skip ahead" when it can find shortcuts, so it tends to jump around a line
  a bit wildly at times.
  
  In practice, the number of times the Tokenizer will B<actually> move the
  character cursor itself is only about 5% - 10% higher than the number of
  tokens contained in the file. This makes it about as optimal as it can be
  made without implementing it in something other than Perl.
  
  In 2001 when PPI was started, this structure made PPI quite slow, and not
  really suitable for interactive tasks. This situation has improved greatly
  with multi-gigahertz processors, but can still be painful when working with
  very large files.
  
  The target parsing rate for PPI is about 5000 lines per gigacycle. It is
  currently believed to be at about 1500, and main avenue for making it to
  the target speed has now become L<PPI::XS>, a drop-in XS accelerator for
  PPI.
  
  Since L<PPI::XS> has only just gotten off the ground and is currently only
  at proof-of-concept stage, this may take a little while. Anyone interested
  in helping out with L<PPI::XS> is B<highly> encouraged to contact the
  author. In fact, the design of L<PPI::XS> means it's possible to port
  one function at a time safely and reliably. So every little bit will help.
  
  =head2 The Lexer
  
  The Lexer takes a token stream, and converts it to a lexical tree. Because
  we are parsing Perl B<documents> this includes whitespace, comments, and
  all number of weird things that have no relevance when code is actually
  executed.
  
  An instantiated L<PPI::Lexer> consumes L<PPI::Tokenizer> objects and
  produces L<PPI::Document> objects. However you should probably never be
  working with the Lexer directly. You should just be able to create
  L<PPI::Document> objects and work with them directly.
  
  =head2 The Perl Document Object Model
  
  The PDOM is a structured collection of data classes that together provide
  a correct and scalable model for documents that follow the standard Perl
  syntax.
  
  =head2 The PDOM Class Tree
  
  The following lists all of the 67 current PDOM classes, listing with indentation
  based on inheritance.
  
     PPI::Element
        PPI::Node
           PPI::Document
              PPI::Document::Fragment
           PPI::Statement
              PPI::Statement::Package
              PPI::Statement::Include
              PPI::Statement::Sub
                 PPI::Statement::Scheduled
              PPI::Statement::Compound
              PPI::Statement::Break
              PPI::Statement::Given
              PPI::Statement::When
              PPI::Statement::Data
              PPI::Statement::End
              PPI::Statement::Expression
                 PPI::Statement::Variable
              PPI::Statement::Null
              PPI::Statement::UnmatchedBrace
              PPI::Statement::Unknown
           PPI::Structure
              PPI::Structure::Block
              PPI::Structure::Subscript
              PPI::Structure::Constructor
              PPI::Structure::Condition
              PPI::Structure::List
              PPI::Structure::For
              PPI::Structure::Given
              PPI::Structure::When
              PPI::Structure::Unknown
        PPI::Token
           PPI::Token::Whitespace
           PPI::Token::Comment
           PPI::Token::Pod
           PPI::Token::Number
              PPI::Token::Number::Binary
              PPI::Token::Number::Octal
              PPI::Token::Number::Hex
              PPI::Token::Number::Float
                 PPI::Token::Number::Exp
              PPI::Token::Number::Version
           PPI::Token::Word
           PPI::Token::DashedWord
           PPI::Token::Symbol
              PPI::Token::Magic
           PPI::Token::ArrayIndex
           PPI::Token::Operator
           PPI::Token::Quote
              PPI::Token::Quote::Single
              PPI::Token::Quote::Double
              PPI::Token::Quote::Literal
              PPI::Token::Quote::Interpolate
           PPI::Token::QuoteLike
              PPI::Token::QuoteLike::Backtick
              PPI::Token::QuoteLike::Command
              PPI::Token::QuoteLike::Regexp
              PPI::Token::QuoteLike::Words
              PPI::Token::QuoteLike::Readline
           PPI::Token::Regexp
              PPI::Token::Regexp::Match
              PPI::Token::Regexp::Substitute
              PPI::Token::Regexp::Transliterate
           PPI::Token::HereDoc
           PPI::Token::Cast
           PPI::Token::Structure
           PPI::Token::Label
           PPI::Token::Separator
           PPI::Token::Data
           PPI::Token::End
           PPI::Token::Prototype
           PPI::Token::Attribute
           PPI::Token::Unknown
  
  To summarize the above layout, all PDOM objects inherit from the
  L<PPI::Element> class.
  
  Under this are L<PPI::Token>, strings of content with a known type,
  and L<PPI::Node>, syntactically significant containers that hold other
  Elements.
  
  The three most important of these are the L<PPI::Document>, the
  L<PPI::Statement> and the L<PPI::Structure> classes.
  
  =head2 The Document, Statement and Structure
  
  At the top of all complete PDOM trees is a L<PPI::Document> object. It
  represents a complete file of Perl source code as you might find it on
  disk.
  
  There are some specialised types of document, such as L<PPI::Document::File>
  and L<PPI::Document::Normalized> but for the purposes of the PDOM they are
  all just considered to be the same thing.
  
  Each Document will contain a number of B<Statements>, B<Structures> and
  B<Tokens>.
  
  A L<PPI::Statement> is any series of Tokens and Structures that are treated
  as a single contiguous statement by perl itself. You should note that a
  Statement is as close as PPI can get to "parsing" the code in the sense that
  perl-itself parses Perl code when it is building the op-tree.
  
  Because of the isolation and Perl's syntax, it is provably impossible for
  PPI to accurately determine precedence of operators or which tokens are
  implicit arguments to a sub call.
  
  So rather than lead you on with a bad guess that has a strong chance of
  being wrong, PPI does not attempt to determine precedence or sub parameters
  at all.
  
  At a fundamental level, it only knows that this series of elements
  represents a single Statement as perl sees it, but it can do so with
  enough certainty that it can be trusted.
  
  However, for specific Statement types the PDOM is able to derive additional
  useful information about their meaning. For the best, most useful, and most
  heavily used example, see L<PPI::Statement::Include>.
  
  A L<PPI::Structure> is any series of tokens contained within matching braces.
  This includes code blocks, conditions, function argument braces, anonymous
  array and hash constructors, lists, scoping braces and all other syntactic
  structures represented by a matching pair of braces, including (although it
  may not seem obvious at first) C<E<lt>READLINEE<gt>> braces.
  
  Each Structure contains none, one, or many Tokens and Structures (the rules
  for which vary for the different Structure subclasses)
  
  Under the PDOM structure rules, a Statement can B<never> directly contain
  another child Statement, a Structure can B<never> directly contain another
  child Structure, and a Document can B<never> contain another Document
  anywhere in the tree.
  
  Aside from these three rules, the PDOM tree is extremely flexible.
  
  =head2 The PDOM at Work
  
  To demonstrate the PDOM in use lets start with an example showing how the
  tree might look for the following chunk of simple Perl code.
  
    #!/usr/bin/perl
  
    print( "Hello World!" );
  
    exit();
  
  Translated into a PDOM tree it would have the following structure (as shown
  via the included L<PPI::Dumper>).
  
    PPI::Document
      PPI::Token::Comment                '#!/usr/bin/perl\n'
      PPI::Token::Whitespace             '\n'
      PPI::Statement::Expression
        PPI::Token::Bareword             'print'
        PPI::Structure::List             ( ... )
          PPI::Token::Whitespace         ' '
          PPI::Statement::Expression
            PPI::Token::Quote::Double    '"Hello World!"'
          PPI::Token::Whitespace         ' '
        PPI::Token::Structure            ';'
      PPI::Token::Whitespace             '\n'
      PPI::Token::Whitespace             '\n'
      PPI::Statement::Expression
        PPI::Token::Bareword             'exit'
        PPI::Structure::List             ( ... )
        PPI::Token::Structure            ';'
      PPI::Token::Whitespace             '\n'
  
  Please note that in this this example, strings are only listed for the
  B<actual> L<PPI::Token> that contains that string. Structures are listed
  with the type of brace characters it represents noted.
  
  The L<PPI::Dumper> module can be used to generate similar trees yourself.
  
  We can make that PDOM dump a little easier to read if we strip out all the
  whitespace. Here it is again, sans the distracting whitespace tokens.
  
    PPI::Document
      PPI::Token::Comment                '#!/usr/bin/perl\n'
      PPI::Statement::Expression
        PPI::Token::Bareword             'print'
        PPI::Structure::List             ( ... )
          PPI::Statement::Expression
            PPI::Token::Quote::Double    '"Hello World!"'
        PPI::Token::Structure            ';'
      PPI::Statement::Expression
        PPI::Token::Bareword             'exit'
        PPI::Structure::List             ( ... )
        PPI::Token::Structure            ';'
  
  As you can see, the tree can get fairly deep at time, especially when every
  isolated token in a bracket becomes its own statement. This is needed to
  allow anything inside the tree the ability to grow. It also makes the
  search and analysis algorithms much more flexible.
  
  Because of the depth and complexity of PDOM trees, a vast number of very easy
  to use methods have been added wherever possible to help people working with
  PDOM trees do normal tasks relatively quickly and efficiently.
  
  =head2 Overview of the Primary Classes
  
  The main PPI classes, and links to their own documentation, are listed
  here in alphabetical order.
  
  =over 4
  
  =item L<PPI::Document>
  
  The Document object, the root of the PDOM.
  
  =item L<PPI::Document::Fragment>
  
  A cohesive fragment of a larger Document. Although not of any real current
  use, it is needed for use in certain internal tree manipulation
  algorithms.
  
  For example, doing things like cut/copy/paste etc. Very similar to a
  L<PPI::Document>, but has some additional methods and does not represent
  a lexical scope boundary.
  
  A document fragment is also non-serializable, and so cannot be written out
  to a file.
  
  =item L<PPI::Dumper>
  
  A simple class for dumping readable debugging versions of PDOM structures,
  such as in the demonstration above.
  
  =item L<PPI::Element>
  
  The Element class is the abstract base class for all objects within the PDOM
  
  =item L<PPI::Find>
  
  Implements an instantiable object form of a PDOM tree search.
  
  =item L<PPI::Lexer>
  
  The PPI Lexer. Converts Token streams into PDOM trees.
  
  =item L<PPI::Node>
  
  The Node object, the abstract base class for all PDOM objects that can
  contain other Elements, such as the Document, Statement and Structure
  objects.
  
  =item L<PPI::Statement>
  
  The base class for all Perl statements. Generic "evaluate for side-effects"
  statements are of this actual type. Other more interesting statement types
  belong to one of its children.
  
  See it's own documentation for a longer description and list of all of the
  different statement types and sub-classes.
  
  =item L<PPI::Structure>
  
  The abstract base class for all structures. A Structure is a language
  construct consisting of matching braces containing a set of other elements.
  
  See the L<PPI::Structure> documentation for a description and
  list of all of the different structure types and sub-classes.
  
  =item L<PPI::Token>
  
  A token is the basic unit of content. At its most basic, a Token is just
  a string tagged with metadata (its class, and some additional flags in
  some cases).
  
  =item L<PPI::Token::_QuoteEngine>
  
  The L<PPI::Token::Quote> and L<PPI::Token::QuoteLike> classes provide
  abstract base classes for the many and varied types of quote and
  quote-like things in Perl. However, much of the actual quote login is
  implemented in a separate quote engine, based at
  L<PPI::Token::_QuoteEngine>.
  
  Classes that inherit from L<PPI::Token::Quote>, L<PPI::Token::QuoteLike>
  and L<PPI::Token::Regexp> are generally parsed only by the Quote Engine.
  
  =item L<PPI::Tokenizer>
  
  The PPI Tokenizer. One Tokenizer consumes a chunk of text and provides
  access to a stream of L<PPI::Token> objects.
  
  The Tokenizer is very very complicated, to the point where even the author
  treads carefully when working with it.
  
  Most of the complication is the result of optimizations which have tripled
  the tokenization speed, at the expense of maintainability. We cope with the
  spaghetti by heavily commenting everything.
  
  =item L<PPI::Transform>
  
  The Perl Document Transformation API. Provides a standard interface and
  abstract base class for objects and classes that manipulate Documents.
  
  =back
  
  =head1 INSTALLING
  
  The core PPI distribution is pure Perl and has been kept as tight as
  possible and with as few dependencies as possible.
  
  It should download and install normally on any platform from within
  the CPAN and CPANPLUS applications, or directly using the distribution
  tarball. If installing by hand, you may need to install a few small
  utility modules first. The exact ones will depend on your version of
  perl.
  
  There are no special install instructions for PPI, and the normal
  C<Perl Makefile.PL>, C<make>, C<make test>, C<make install> instructions
  apply.
  
  =head1 EXTENDING
  
  The PPI namespace itself is reserved for the sole use of the modules under
  the umbrella of the C<Parse::Perl> SourceForge project.
  
  L<http://sf.net/projects/parseperl>
  
  You are recommended to use the PPIx:: namespace for PPI-specific
  modifications or prototypes thereof, or Perl:: for modules which provide
  a general Perl language-related functions.
  
  If what you wish to implement looks like it fits into PPIx:: namespace,
  you should consider contacting the C<Parse::Perl> mailing list (detailed on
  the SourceForge site) first, as what you want may already be in progress,
  or you may wish to consider joining the team and doing it within the
  C<Parse::Perl> project itself.
  
  =head1 TO DO
  
  - Many more analysis and utility methods for PDOM classes
  
  - Creation of a PPI::Tutorial document
  
  - Add many more key functions to PPI::XS
  
  - We can B<always> write more and better unit tests
  
  - Complete the full implementation of -E<gt>literal (1.200)
  
  - Full understanding of scoping (due 1.300)
  
  =head1 SUPPORT
  
  This module is stored in an Open Repository at the following address.
  
  L<http://svn.ali.as/cpan/trunk/PPI>
  
  Write access to the repository is made available automatically to any
  published CPAN author, and to most other volunteers on request.
  
  If you are able to submit your bug report in the form of new (failing)
  unit tests, or can apply your fix directly instead of submitting a patch,
  you are B<strongly> encouraged to do so, as the author currently maintains
  over 100 modules and it can take some time to deal with non-"Critical" bug
  reports or patches.
  
  This will also guarentee that your issue will be addressed in the next
  release of the module.
  
  For large changes though, please consider creating a branch so that they
  can be properly reviewed and trialed before being applied to the trunk.
  
  If you cannot provide a direct test or fix, or don't have time to do so,
  then regular bug reports are still accepted and appreciated via the CPAN
  bug tracker.
  
  L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=PPI>
  
  For other issues or questions, contact the C<Parse::Perl> project mailing
  list.
  
  For commercial or media-related enquiries, or to have your SVN commit bit
  enabled, contact the author.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 ACKNOWLEDGMENTS
  
  A huge thank you to Phase N Australia (L<http://phase-n.com/>) for
  permitting the original open sourcing and release of this distribution
  from what was originally several thousand hours of commercial work.
  
  Another big thank you to The Perl Foundation
  (L<http://www.perlfoundation.org/>) for funding for the final big
  refactoring and completion run.
  
  Also, to the various co-maintainers that have contributed both large and
  small with tests and patches and especially to those rare few who have
  deep-dived into the guts to (gasp) add a feature.
  
    - Dan Brook       : PPIx::XPath, Acme::PerlML
    - Audrey Tang     : "Line Noise" Testing
    - Arjen Laarhoven : Three-element ->location support
    - Elliot Shank    : Perl 5.10 support, five-element ->location
  
  And finally, thanks to those brave ( and foolish :) ) souls willing to dive
  in and use, test drive and provide feedback on PPI before version 1.000,
  in some cases before it made it to beta quality, and still did extremely
  distasteful things (like eating 50 meg of RAM a second).
  
  I owe you all a beer. Corner me somewhere and collect at your convenience.
  If I missed someone who wasn't in my email history, thank you too :)
  
    # In approximate order of appearance
    - Claes Jacobsson
    - Michael Schwern
    - Jeff T. Parsons
    - CPAN Author "CHOCOLATEBOY"
    - Robert Rotherberg
    - CPAN Author "PODMASTER"
    - Richard Soderberg
    - Nadim ibn Hamouda el Khemir
    - Graciliano M. P.
    - Leon Brocard
    - Jody Belka
    - Curtis Ovid
    - Yuval Kogman
    - Michael Schilli
    - Slaven Rezic
    - Lars Thegler
    - Tony Stubblebine
    - Tatsuhiko Miyagawa
    - CPAN Author "CHROMATIC"
    - Matisse Enzer
    - Roy Fulbright
    - Dan Brook
    - Johnny Lee
    - Johan Lindstrom
  
  And to single one person out, thanks go to Randal Schwartz who
  spent a great number of hours in IRC over a critical 6 month period
  explaining why Perl is impossibly unparsable and constantly shoving evil
  and ugly corner cases in my face. He remained a tireless devil's advocate,
  and without his support this project genuinely could never have been
  completed.
  
  So for my schooling in the Deep Magiks, you have my deepest gratitude Randal.
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI

$fatpacked{"PPI/Cache.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_CACHE';
  package PPI::Cache;
  
  =pod
  
  =head1 NAME
  
  PPI::Cache - The PPI Document Caching Layer
  
  =head1 SYNOPSIS
  
    # Set the cache
    use PPI::Cache path => '/var/cache/ppi-cache';
    
    # Manually create a cache
    my $Cache = PPI::Cache->new(
        path     => '/var/cache/perl/class-PPI',
        readonly => 1,
    );
  
  =head1 DESCRIPTION
  
  C<PPI::Cache> provides the default caching functionality for L<PPI>.
  
  It integrates automatically with L<PPI> itself. Once enabled, any attempt
  to load a document from the filesystem will be cached via cache.
  
  Please note that creating a L<PPI::Document> from raw source or something
  other object will B<not> be cached.
  
  =head2 Using PPI::Cache
  
  The most common way of using C<PPI::Cache> is to provide parameters to
  the C<use> statement at the beginning of your program.
  
    # Load the class but do not set a cache
    use PPI::Cache;
    
    # Use a fairly normal cache location
    use PPI::Cache path => '/var/cache/ppi-cache';
  
  Any of the arguments that can be provided to the C<new> constructor can
  also be provided to C<use>.
  
  =head1 METHODS
  
  =cut
  
  use strict;
  use Carp          ();
  use File::Spec    ();
  use File::Path    ();
  use Storable      ();
  use Digest::MD5   ();
  use Params::Util  qw{_INSTANCE _SCALAR};
  use PPI::Document ();
  
  use vars qw{$VERSION};
  BEGIN {
  	$VERSION = '1.215';
  }
  
  use constant VMS => !! ( $^O eq 'VMS' );
  
  sub import {
  	my $class = ref $_[0] ? ref shift : shift;
  	return 1 unless @_;
  
  	# Create a cache from the params provided
  	my $cache = $class->new(@_);
  
  	# Make PPI::Document use it
  	unless ( PPI::Document->set_cache( $cache ) ) {
  		Carp::croak("Failed to set cache in PPI::Document");
  	}
  
  	1;
  }
  
  
  
  
  
  #####################################################################
  # Constructor and Accessors
  
  =pod
  
  =head2 new param => $value, ...
  
  The C<new> constructor creates a new standalone cache object.
  
  It takes a number of parameters to control the cache.
  
  =over
  
  =item path
  
  The C<path> param sets the base directory for the cache. It must already
  exist, and must be writable.
  
  =item readonly
  
  The C<readonly> param is a true/false flag that allows the use of an
  existing cache by a less-privileged user (such as the web user).
  
  Existing documents will be retrieved from the cache, but new documents
  will not be written to it.
  
  =back
  
  Returns a new C<PPI::Cache> object, or dies on error.
  
  =cut
  
  sub new {
  	my $class  = shift;
  	my %params = @_;
  
  	# Path should exist and be usable
  	my $path = $params{path}
  		or Carp::croak("Cannot create PPI::Cache, no path provided");
  	unless ( -d $path ) {
  		Carp::croak("Cannot create PPI::Cache, path does not exist");
  	}
  	unless ( -r $path and -x $path ) {
  		Carp::croak("Cannot create PPI::Cache, no read permissions for path");
  	}
  	if ( ! $params{readonly} and ! -w $path ) {
  		Carp::croak("Cannot create PPI::Cache, no write permissions for path");
  	}
  
  	# Create the basic object
  	my $self = bless {
  		path     => $path,
  		readonly => !! $params{readonly},
  	}, $class;
  
  	$self;
  }
  
  =pod
  
  =head2 path
  
  The C<path> accessor returns the path on the local filesystem that is the
  root of the cache.
  
  =cut
  
  sub path { $_[0]->{path} }
  
  =pod
  
  =head2 readonly
  
  The C<readonly> accessor returns true if documents should not be written
  to the cache.
  
  =cut
  
  sub readonly { $_[0]->{readonly} }
  
  
  
  
  
  #####################################################################
  # PPI::Cache Methods
  
  =pod
  
  =head2 get_document $md5sum | \$source
  
  The C<get_document> method checks to see if a Document is stored in the
  cache and retrieves it if so.
  
  =cut
  
  sub get_document {
  	my $self = ref $_[0]
  		? shift
  		: Carp::croak('PPI::Cache::get_document called as static method');
  	my $md5hex = $self->_md5hex(shift) or return undef;
  	$self->_load($md5hex);
  }
  
  =pod
  
  =head2 store_document $Document
  
  The C<store_document> method takes a L<PPI::Document> as argument and
  explicitly adds it to the cache.
  
  Returns true if saved, or C<undef> (or dies) on error.
  
  FIXME (make this return either one or the other, not both)
  
  =cut
  
  sub store_document {
  	my $self     = shift;
  	my $Document = _INSTANCE(shift, 'PPI::Document') or return undef;
  
  	# Shortcut if we are readonly
  	return 1 if $self->readonly;
  
  	# Find the filename to save to
  	my $md5hex = $Document->hex_id or return undef;
  
  	# Store the file
  	$self->_store( $md5hex, $Document );
  }
  
  
  
  
  
  #####################################################################
  # Support Methods
  
  # Store an arbitrary PPI::Document object (using Storable) to a particular
  # path within the cache filesystem.
  sub _store {
  	my ($self, $md5hex, $object) = @_;
  	my ($dir, $file) = $self->_paths($md5hex);
  
  	# Save the file
  	File::Path::mkpath( $dir, 0, 0755 ) unless -d $dir;
  	if ( VMS ) {
  		Storable::lock_nstore( $object, $file );
  	} else {
  		Storable::nstore( $object, $file );
  	}
  }
  
  # Load an arbitrary object (using Storable) from a particular
  # path within the cache filesystem.
  sub _load {
  	my ($self, $md5hex) = @_;
  	my (undef, $file) = $self->_paths($md5hex);
  
  	# Load the file
  	return '' unless -f $file;
  	my $object = VMS
  		? Storable::retrieve( $file )
  		: Storable::lock_retrieve( $file );
  
  	# Security check
  	unless ( _INSTANCE($object, 'PPI::Document') ) {
  		Carp::croak("Security Violation: Object in '$file' is not a PPI::Document");
  	}
  
  	$object;
  }
  
  # Convert a md5 to a dir and file name
  sub _paths {
  	my $self   = shift;
  	my $md5hex = lc shift;
  	my $dir    = File::Spec->catdir( $self->path, substr($md5hex, 0, 1), substr($md5hex, 0, 2) );
  	my $file   = File::Spec->catfile( $dir, $md5hex . '.ppi' );
  	return ($dir, $file);
  }
  
  # Check a md5hex param
  sub _md5hex {
  	my $either = shift;
  	my $it     = _SCALAR($_[0])
  		? PPI::Util::md5hex(${$_[0]})
  		: $_[0];
  	return (defined $it and ! ref $it and $it =~ /^[a-f0-9]{32}\z/si)
  		? lc $it
  		: undef;
  }
  
  1;
  
  =pod
  
  =head1 TO DO
  
  - Finish the basic functionality
  
  - Add support for use PPI::Cache auto-setting $PPI::Document::CACHE
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2005 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_CACHE

$fatpacked{"PPI/Document.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_DOCUMENT';
  package PPI::Document;
  
  =pod
  
  =head1 NAME
  
  PPI::Document - Object representation of a Perl document
  
  =head1 INHERITANCE
  
    PPI::Document
    isa PPI::Node
        isa PPI::Element
  
  =head1 SYNOPSIS
  
    use PPI;
    
    # Load a document from a file
    my $Document = PPI::Document->new('My/Module.pm');
    
    # Strip out comments
    $Document->prune('PPI::Token::Comment');
    
    # Find all the named subroutines
    my $sub_nodes = $Document->find( 
    	sub { $_[1]->isa('PPI::Statement::Sub') and $_[1]->name }
    );
    my @sub_names = map { $_->name } @$sub_nodes;
    
    # Save the file
    $Document->save('My/Module.pm.stripped');
  
  =head1 DESCRIPTION
  
  The C<PPI::Document> class represents a single Perl "document". A
  C<PPI::Document> object acts as a root L<PPI::Node>, with some
  additional methods for loading and saving, and working with
  the line/column locations of Elements within a file.
  
  The exemption to its L<PPI::Node>-like behavior this is that a
  C<PPI::Document> object can NEVER have a parent node, and is always
  the root node in a tree.
  
  =head2 Storable Support
  
  C<PPI::Document> implements the necessary C<STORABLE_freeze> and
  C<STORABLE_thaw> hooks to provide native support for L<Storable>,
  if you have it installed.
  
  However if you want to clone clone a Document, you are highly recommended
  to use the internal C<$Document-E<gt>clone> method rather than Storable's
  C<dclone> function (although C<dclone> should still work).
  
  =head1 METHODS
  
  Most of the things you are likely to want to do with a Document are
  probably going to involve the methods from L<PPI::Node> class, of which
  this is a subclass.
  
  The methods listed here are the remaining few methods that are truly
  Document-specific.
  
  =cut
  
  use strict;
  use Carp                          ();
  use List::MoreUtils               ();
  use Params::Util                  qw{_SCALAR0 _ARRAY0 _INSTANCE};
  use Digest::MD5                   ();
  use PPI::Util                     ();
  use PPI                           ();
  use PPI::Node                     ();
  use PPI::Exception::ParserTimeout ();
  
  use overload 'bool' => \&PPI::Util::TRUE;
  use overload '""'   => 'content';
  
  use vars qw{$VERSION @ISA $errstr};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Node';
  	$errstr  = '';
  }
  
  use PPI::Document::Fragment ();
  
  # Document cache
  my $CACHE = undef;
  
  # Convenience constants related to constants
  use constant LOCATION_LINE         => 0;
  use constant LOCATION_CHARACTER    => 1;
  use constant LOCATION_COLUMN       => 2;
  use constant LOCATION_LOGICAL_LINE => 3;
  use constant LOCATION_LOGICAL_FILE => 4;
  
  
  
  
  
  #####################################################################
  # Constructor and Static Methods
  
  =pod
  
  =head2 new
  
    # Simple construction
    $doc = PPI::Document->new( $filename );
    $doc = PPI::Document->new( \$source  );
    
    # With the readonly attribute set
    $doc = PPI::Document->new( $filename,
            readonly => 1,
    );
  
  The C<new> constructor takes as argument a variety of different sources of
  Perl code, and creates a single cohesive Perl C<PPI::Document>
  for it.
  
  If passed a file name as a normal string, it will attempt to load the
  document from the file.
  
  If passed a reference to a C<SCALAR>, this is taken to be source code and
  parsed directly to create the document.
  
  If passed zero arguments, a "blank" document will be created that contains
  no content at all.
  
  In all cases, the document is considered to be "anonymous" and not tied back
  to where it was created from. Specifically, if you create a PPI::Document from
  a filename, the document will B<not> remember where it was created from.
  
  The constructor also takes attribute flags.
  
  At this time, the only available attribute is the C<readonly> flag.
  
  Setting C<readonly> to true will allow various systems to provide
  additional optimisations and caching. Note that because C<readonly> is an
  optimisation flag, it is off by default and you will need to explicitly
  enable it.
  
  Returns a C<PPI::Document> object, or C<undef> if parsing fails.
  
  =cut
  
  sub new {
  	local $_; # An extra one, just in case
  	my $class = ref $_[0] ? ref shift : shift;
  
  	unless ( @_ ) {
  		my $self = $class->SUPER::new;
  		$self->{readonly}  = ! 1;
  		$self->{tab_width} = 1;
  		return $self;
  	}
  
  	# Check constructor attributes
  	my $source  = shift;
  	my %attr    = @_;
  	my $timeout = delete $attr{timeout};
  	if ( $timeout and ! PPI::Util::HAVE_ALARM() ) {
  		Carp::croak("This platform does not support PPI parser timeouts");
  	}
  
  	# Check the data source
  	if ( ! defined $source ) {
  		$class->_error("An undefined value was passed to PPI::Document::new");
  
  	} elsif ( ! ref $source ) {
  		# Catch people using the old API
  		if ( $source =~ /(?:\012|\015)/ ) {
  			Carp::croak("API CHANGE: Source code should only be passed to PPI::Document->new as a SCALAR reference");
  		}
  
  		# When loading from a filename, use the caching layer if it exists.
  		if ( $CACHE ) {
  			my $file   = $source;
  			my $source = PPI::Util::_slurp( $file );
  			unless ( ref $source ) {
  				# Errors returned as plain string
  				return $class->_error($source);
  			}
  
  			# Retrieve the document from the cache
  			my $document = $CACHE->get_document($source);
  			return $class->_setattr( $document, %attr ) if $document;
  
  			if ( $timeout ) {
  				eval {
  					local $SIG{ALRM} = sub { die "alarm\n" };
  					alarm( $timeout );
  					$document = PPI::Lexer->lex_source( $$source );
  					alarm( 0 );
  				};
  			} else {
  				$document = PPI::Lexer->lex_source( $$source );
  			}
  			if ( $document ) {
  				# Save in the cache
  				$CACHE->store_document( $document );
  				return $class->_setattr( $document, %attr );
  			}
  		} else {
  			if ( $timeout ) {
  				eval {
  					local $SIG{ALRM} = sub { die "alarm\n" };
  					alarm( $timeout );
  					my $document = PPI::Lexer->lex_file( $source );
  					return $class->_setattr( $document, %attr ) if $document;
  					alarm( 0 );
  				};
  			} else {
  				my $document = PPI::Lexer->lex_file( $source );
  				return $class->_setattr( $document, %attr ) if $document;
  			}
  		}
  
  	} elsif ( _SCALAR0($source) ) {
  		if ( $timeout ) {
  			eval {
  				local $SIG{ALRM} = sub { die "alarm\n" };
  				alarm( $timeout );
  				my $document = PPI::Lexer->lex_source( $$source );
  				return $class->_setattr( $document, %attr ) if $document;
  				alarm( 0 );
  			};
  		} else {
  			my $document = PPI::Lexer->lex_source( $$source );
  			return $class->_setattr( $document, %attr ) if $document;
  		}
  
  	} elsif ( _ARRAY0($source) ) {
  		$source = join '', map { "$_\n" } @$source;
  		if ( $timeout ) {
  			eval {
  				local $SIG{ALRM} = sub { die "alarm\n" };
  				alarm( $timeout );
  				my $document = PPI::Lexer->lex_source( $source );
  				return $class->_setattr( $document, %attr ) if $document;
  				alarm( 0 );
  			};
  		} else {
  			my $document = PPI::Lexer->lex_source( $source );
  			return $class->_setattr( $document, %attr ) if $document;
  		}
  
  	} else {
  		$class->_error("Unknown object or reference was passed to PPI::Document::new");
  	}
  
  	# Pull and store the error from the lexer
  	my $errstr;
  	if ( _INSTANCE($@, 'PPI::Exception::Timeout') ) {
  		$errstr = 'Timed out while parsing document';
  	} elsif ( _INSTANCE($@, 'PPI::Exception') ) {
  		$errstr = $@->message;
  	} elsif ( $@ ) {
  		$errstr = $@;
  		$errstr =~ s/\sat line\s.+$//;
  	} elsif ( PPI::Lexer->errstr ) {
  		$errstr = PPI::Lexer->errstr;
  	} else {
  		$errstr = "Unknown error parsing Perl document";
  	}
  	PPI::Lexer->_clear;
  	$class->_error( $errstr );
  }
  
  sub load {
  	Carp::croak("API CHANGE: File names should now be passed to PPI::Document->new to load a file");
  }
  
  sub _setattr {
  	my ($class, $document, %attr) = @_;
  	$document->{readonly} = !! $attr{readonly};
  	return $document;
  }
  
  =pod
  
  =head2 set_cache $cache
  
  As of L<PPI> 1.100, C<PPI::Document> supports parser caching.
  
  The default cache class L<PPI::Cache> provides a L<Storable>-based
  caching or the parsed document based on the MD5 hash of the document as
  a string.
  
  The static C<set_cache> method is used to set the cache object for
  C<PPI::Document> to use when loading documents. It takes as argument
  a L<PPI::Cache> object (or something that C<isa> the same).
  
  If passed C<undef>, this method will stop using the current cache, if any.
  
  For more information on caching, see L<PPI::Cache>.
  
  Returns true on success, or C<undef> if not passed a valid param.
  
  =cut
  
  sub set_cache {
  	my $class  = ref $_[0] ? ref shift : shift;
  
  	if ( defined $_[0] ) {
  		# Enable the cache
  		my $object = _INSTANCE(shift, 'PPI::Cache') or return undef;
  		$CACHE = $object;
  	} else {
  		# Disable the cache
  		$CACHE = undef;
  	}
  
  	1;
  }
  
  =pod
  
  =head2 get_cache
  
  If a document cache is currently set, the C<get_cache> method will
  return it.
  
  Returns a L<PPI::Cache> object, or C<undef> if there is no cache
  currently set for C<PPI::Document>.
  
  =cut
  
  sub get_cache {
  	$CACHE;	
  }
  
  
  
  
  
  #####################################################################
  # PPI::Document Instance Methods
  
  =pod
  
  =head2 readonly
  
  The C<readonly> attribute indicates if the document is intended to be
  read-only, and will never be modified. This is an advisory flag, that
  writers of L<PPI>-related systems may or may not use to enable
  optimisations and caches for your document.
  
  Returns true if the document is read-only or false if not.
  
  =cut
  
  sub readonly {
  	$_[0]->{readonly};
  }
  
  =pod
  
  =head2 tab_width [ $width ]
  
  In order to handle support for C<location> correctly, C<Documents>
  need to understand the concept of tabs and tab width. The C<tab_width>
  method is used to get and set the size of the tab width.
  
  At the present time, PPI only supports "naive" (width 1) tabs, but we do
  plan on supporting arbitrary, default and auto-sensing tab widths later.
  
  Returns the tab width as an integer, or C<die>s if you attempt to set the
  tab width.
  
  =cut
  
  sub tab_width {
  	my $self = shift;
  	return $self->{tab_width} unless @_;
  	$self->{tab_width} = shift;
  }
  
  =pod
  
  =head2 save
  
    $document->save( $file )
   
  The C<save> method serializes the C<PPI::Document> object and saves the
  resulting Perl document to a file. Returns C<undef> on failure to open
  or write to the file.
  
  =cut
  
  sub save {
  	my $self = shift;
  	local *FILE;
  	open( FILE, '>', $_[0] )    or return undef;
  	print FILE $self->serialize or return undef;
  	close FILE                  or return undef;
  	return 1;
  }
  
  =pod
  
  =head2 serialize
  
  Unlike the C<content> method, which shows only the immediate content
  within an element, Document objects also have to be able to be written
  out to a file again.
  
  When doing this we need to take into account some additional factors.
  
  Primarily, we need to handle here-docs correctly, so that are written
  to the file in the expected place.
  
  The C<serialize> method generates the actual file content for a given
  Document object. The resulting string can be written straight to a file.
  
  Returns the serialized document as a string.
  
  =cut
  
  sub serialize {
  	my $self   = shift;
  	my @tokens = $self->tokens;
  
  	# The here-doc content buffer
  	my $heredoc = '';
  
  	# Start the main loop
  	my $output = '';
  	foreach my $i ( 0 .. $#tokens ) {
  		my $Token = $tokens[$i];
  
  		# Handle normal tokens
  		unless ( $Token->isa('PPI::Token::HereDoc') ) {
  			my $content = $Token->content;
  
  			# Handle the trivial cases
  			unless ( $heredoc ne '' and $content =~ /\n/ ) {
  				$output .= $content;
  				next;
  			}
  
  			# We have pending here-doc content that needs to be
  			# inserted just after the first newline in the content.
  			if ( $content eq "\n" ) {
  				# Shortcut the most common case for speed
  				$output .= $content . $heredoc;
  			} else {
  				# Slower and more general version
  				$content =~ s/\n/\n$heredoc/;
  				$output .= $content;
  			}
  
  			$heredoc = '';
  			next;
  		}
  
  		# This token is a HereDoc.
  		# First, add the token content as normal, which in this
  		# case will definately not contain a newline.
  		$output .= $Token->content;
  
  		# Now add all of the here-doc content to the heredoc buffer.
  		foreach my $line ( $Token->heredoc ) {
  			$heredoc .= $line;
  		}
  
  		if ( $Token->{_damaged} ) {
  			# Special Case:
  			# There are a couple of warning/bug situations
  			# that can occur when a HereDoc content was read in
  			# from the end of a file that we silently allow.
  			#
  			# When writing back out to the file we have to
  			# auto-repair these problems if we arn't going back
  			# on to the end of the file.
  
  			# When calculating $last_line, ignore the final token if
  			# and only if it has a single newline at the end.
  			my $last_index = $#tokens;
  			if ( $tokens[$last_index]->{content} =~ /^[^\n]*\n$/ ) {
  				$last_index--;
  			}
  
  			# This is a two part test.
  			# First, are we on the last line of the
  			# content part of the file
  			my $last_line = List::MoreUtils::none {
  				$tokens[$_] and $tokens[$_]->{content} =~ /\n/
  				} (($i + 1) .. $last_index);
  			if ( ! defined $last_line ) {
  				# Handles the null list case
  				$last_line = 1;
  			}
  
  			# Secondly, are their any more here-docs after us,
  			# (with content or a terminator)
  			my $any_after = List::MoreUtils::any {
  				$tokens[$_]->isa('PPI::Token::HereDoc')
  				and (
  					scalar(@{$tokens[$_]->{_heredoc}})
  					or
  					defined $tokens[$_]->{_terminator_line}
  					)
  				} (($i + 1) .. $#tokens);
  			if ( ! defined $any_after ) {
  				# Handles the null list case
  				$any_after = '';
  			}
  
  			# We don't need to repair the last here-doc on the
  			# last line. But we do need to repair anything else.
  			unless ( $last_line and ! $any_after ) {
  				# Add a terminating string if it didn't have one
  				unless ( defined $Token->{_terminator_line} ) {
  					$Token->{_terminator_line} = $Token->{_terminator};
  				}
  
  				# Add a trailing newline to the terminating
  				# string if it didn't have one.
  				unless ( $Token->{_terminator_line} =~ /\n$/ ) {
  					$Token->{_terminator_line} .= "\n";
  				}
  			}
  		}
  
  		# Now add the termination line to the heredoc buffer
  		if ( defined $Token->{_terminator_line} ) {
  			$heredoc .= $Token->{_terminator_line};
  		}
  	}
  
  	# End of tokens
  
  	if ( $heredoc ne '' ) {
  		# If the file doesn't end in a newline, we need to add one
  		# so that the here-doc content starts on the next line.
  		unless ( $output =~ /\n$/ ) {
  			$output .= "\n";
  		}
  
  		# Now we add the remaining here-doc content
  		# to the end of the file.
  		$output .= $heredoc;
  	}
  
  	$output;
  }
  
  =pod
  
  =head2 hex_id
  
  The C<hex_id> method generates an unique identifier for the Perl document.
  
  This identifier is basically just the serialized document, with
  Unix-specific newlines, passed through MD5 to produce a hexadecimal string.
  
  This identifier is used by a variety of systems (such as L<PPI::Cache>
  and L<Perl::Metrics>) as a unique key against which to store or cache
  information about a document (or indeed, to cache the document itself).
  
  Returns a 32 character hexadecimal string.
  
  =cut
  
  sub hex_id {
  	PPI::Util::md5hex($_[0]->serialize);
  }
  
  =pod
  
  =head2 index_locations
  
  Within a document, all L<PPI::Element> objects can be considered to have a
  "location", a line/column position within the document when considered as a
  file. This position is primarily useful for debugging type activities.
  
  The method for finding the position of a single Element is a bit laborious,
  and very slow if you need to do it a lot. So the C<index_locations> method
  will index and save the locations of every Element within the Document in
  advance, making future calls to <PPI::Element::location> virtually free.
  
  Please note that this index should always be cleared using C<flush_locations>
  once you are finished with the locations. If content is added to or removed
  from the file, these indexed locations will be B<wrong>.
  
  =cut
  
  sub index_locations {
  	my $self   = shift;
  	my @tokens = $self->tokens;
  
  	# Whenever we hit a heredoc we will need to increment by
  	# the number of lines in it's content section when when we
  	# encounter the next token with a newline in it.
  	my $heredoc = 0;
  
  	# Find the first Token without a location
  	my ($first, $location) = ();
  	foreach ( 0 .. $#tokens ) {
  		my $Token = $tokens[$_];
  		next if $Token->{_location};
  
  		# Found the first Token without a location
  		# Calculate the new location if needed.
  		if ($_) {
  			$location =
  				$self->_add_location( $location, $tokens[$_ - 1], \$heredoc );
  		} else {
  			my $logical_file =
  				$self->can('filename') ? $self->filename : undef;
  			$location = [ 1, 1, 1, 1, $logical_file ];
  		}
  		$first = $_;
  		last;
  	}
  
  	# Calculate locations for the rest
  	if ( defined $first ) {
  		foreach ( $first .. $#tokens ) {
  			my $Token = $tokens[$_];
  			$Token->{_location} = $location;
  			$location = $self->_add_location( $location, $Token, \$heredoc );
  
  			# Add any here-doc lines to the counter
  			if ( $Token->isa('PPI::Token::HereDoc') ) {
  				$heredoc += $Token->heredoc + 1;
  			}
  		}
  	}
  
  	1;
  }
  
  sub _add_location {
  	my ($self, $start, $Token, $heredoc) = @_;
  	my $content = $Token->{content};
  
  	# Does the content contain any newlines
  	my $newlines =()= $content =~ /\n/g;
  	my ($logical_line, $logical_file) =
  		$self->_logical_line_and_file($start, $Token, $newlines);
  
  	unless ( $newlines ) {
  		# Handle the simple case
  		return [
  			$start->[LOCATION_LINE],
  			$start->[LOCATION_CHARACTER] + length($content),
  			$start->[LOCATION_COLUMN]
  				+ $self->_visual_length(
  					$content,
  					$start->[LOCATION_COLUMN]
  				),
  			$logical_line,
  			$logical_file,
  		];
  	}
  
  	# This is the more complex case where we hit or
  	# span a newline boundary.
  	my $physical_line = $start->[LOCATION_LINE] + $newlines;
  	my $location = [ $physical_line, 1, 1, $logical_line, $logical_file ];
  	if ( $heredoc and $$heredoc ) {
  		$location->[LOCATION_LINE]         += $$heredoc;
  		$location->[LOCATION_LOGICAL_LINE] += $$heredoc;
  		$$heredoc = 0;
  	}
  
  	# Does the token have additional characters
  	# after their last newline.
  	if ( $content =~ /\n([^\n]+?)\z/ ) {
  		$location->[LOCATION_CHARACTER] += length($1);
  		$location->[LOCATION_COLUMN] +=
  			$self->_visual_length(
  				$1, $location->[LOCATION_COLUMN],
  			);
  	}
  
  	$location;
  }
  
  sub _logical_line_and_file {
  	my ($self, $start, $Token, $newlines) = @_;
  
  	# Regex taken from perlsyn, with the correction that there's no space
  	# required between the line number and the file name.
  	if ($start->[LOCATION_CHARACTER] == 1) {
  		if ( $Token->isa('PPI::Token::Comment') ) {
  			if (
  				$Token->content =~ m<
  					\A
  					\#      \s*
  					line    \s+
  					(\d+)   \s*
  					(?: (\"?) ([^\"]* [^\s\"]) \2 )?
  					\s*
  					\z
  				>xms
  			) {
  				return $1, ($3 || $start->[LOCATION_LOGICAL_FILE]);
  			}
  		}
  		elsif ( $Token->isa('PPI::Token::Pod') ) {
  			my $content = $Token->content;
  			my $line;
  			my $file = $start->[LOCATION_LOGICAL_FILE];
  			my $end_of_directive;
  			while (
  				$content =~ m<
  					^
  					\#      \s*?
  					line    \s+?
  					(\d+)   (?: (?! \n) \s)*
  					(?: (\"?) ([^\"]*? [^\s\"]) \2 )??
  					\s*?
  					$
  				>xmsg
  			) {
  				($line, $file) = ($1, ( $3 || $file ) );
  				$end_of_directive = pos $content;
  			}
  
  			if (defined $line) {
  				pos $content = $end_of_directive;
  				my $post_directive_newlines =()= $content =~ m< \G [^\n]* \n >xmsg;
  				return $line + $post_directive_newlines - 1, $file;
  			}
  		}
  	}
  
  	return
  		$start->[LOCATION_LOGICAL_LINE] + $newlines,
  		$start->[LOCATION_LOGICAL_FILE];
  }
  
  sub _visual_length {
  	my ($self, $content, $pos) = @_;
  
  	my $tab_width = $self->tab_width;
  	my ($length, $vis_inc);
  
  	return length $content if $content !~ /\t/;
  
  	# Split the content in tab and non-tab parts and calculate the
  	# "visual increase" of each part.
  	for my $part ( split(/(\t)/, $content) ) {
  		if ($part eq "\t") {
  			$vis_inc = $tab_width - ($pos-1) % $tab_width;
  		}
  		else {
  			$vis_inc = length $part;
  		}
  		$length += $vis_inc;
  		$pos    += $vis_inc;
  	}
  
  	$length;
  }
  
  =pod
  
  =head2 flush_locations
  
  When no longer needed, the C<flush_locations> method clears all location data
  from the tokens.
  
  =cut
  
  sub flush_locations {
  	shift->_flush_locations(@_);
  }
  
  =pod
  
  =head2 normalized
  
  The C<normalized> method is used to generate a "Layer 1"
  L<PPI::Document::Normalized> object for the current Document.
  
  A "normalized" Perl Document is an arbitrary structure that removes any
  irrelevant parts of the document and refactors out variations in style,
  to attempt to approach something that is closer to the "true meaning"
  of the Document.
  
  See L<PPI::Normal> for more information on document normalization and
  the tasks for which it is useful.
  
  Returns a L<PPI::Document::Normalized> object, or C<undef> on error.
  
  =cut
  
  sub normalized {
  	# The normalization process will utterly destroy and mangle
  	# anything passed to it, so we are going to only give it a
  	# clone of ourself.
  	PPI::Normal->process( $_[0]->clone );
  }
  
  =pod
  
  =head1 complete
  
  The C<complete> method is used to determine if a document is cleanly
  structured, all braces are closed, the final statement is
  fully terminated and all heredocs are fully entered.
  
  Returns true if the document is complete or false if not.
  
  =cut
  
  sub complete {
  	my $self = shift;
  
  	# Every structure has to be complete
  	$self->find_any( sub {
  		$_[1]->isa('PPI::Structure')
  		and
  		! $_[1]->complete
  	} )
  	and return '';
  
  	# Strip anything that isn't a statement off the end
  	my @child = $self->children;
  	while ( @child and not $child[-1]->isa('PPI::Statement') ) {
  		pop @child;
  	}
  
  	# We must have at least one statement
  	return '' unless @child;
  
  	# Check the completeness of the last statement
  	return $child[-1]->_complete;
  }
  
  
  
  
  
  #####################################################################
  # PPI::Node Methods
  
  # We are a scope boundary
  ### XS -> PPI/XS.xs:_PPI_Document__scope 0.903+
  sub scope { 1 }
  
  
  
  
  
  #####################################################################
  # PPI::Element Methods
  
  sub insert_before {
  	return undef;
  	# die "Cannot insert_before a PPI::Document";
  }
  
  sub insert_after {
  	return undef;
  	# die "Cannot insert_after a PPI::Document";
  }
  
  sub replace {
  	return undef;
  	# die "Cannot replace a PPI::Document";
  }
  
  
  
  
  
  #####################################################################
  # Error Handling
  
  # Set the error message
  sub _error {
  	$errstr = $_[1];
  	undef;
  }
  
  # Clear the error message.
  # Returns the object as a convenience.
  sub _clear {
  	$errstr = '';
  	$_[0];
  }
  
  =pod
  
  =head2 errstr
  
  For error that occur when loading and saving documents, you can use
  C<errstr>, as either a static or object method, to access the error message.
  
  If a Document loads or saves without error, C<errstr> will return false.
  
  =cut
  
  sub errstr {
  	$errstr;
  }
  
  
  
  
  
  #####################################################################
  # Native Storable Support
  
  sub STORABLE_freeze {
  	my $self  = shift;
  	my $class = ref $self;
  	my %hash  = %$self;
  	return ($class, \%hash);
  }
  
  sub STORABLE_thaw {
  	my ($self, undef, $class, $hash) = @_;
  	bless $self, $class;
  	foreach ( keys %$hash ) {
  		$self->{$_} = delete $hash->{$_};
  	}
  	$self->__link_children;
  }
  
  1;
  
  =pod
  
  =head1 TO DO
  
  - May need to overload some methods to forcefully prevent Document
  objects becoming children of another Node.
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 SEE ALSO
  
  L<PPI>, L<http://ali.as/>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_DOCUMENT

$fatpacked{"PPI/Document/File.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_DOCUMENT_FILE';
  package PPI::Document::File;
  
  =pod
  
  =head1 NAME
  
  PPI::Document::File - A Perl Document located in a specific file
  
  =head1 DESCRIPTION
  
  B<WARNING: This class is experimental, and may change without notice>
  
  B<PPI::Document::File> provides a L<PPI::Document> subclass that represents
  a Perl document stored in a specific named file.
  
  =head1 METHODS
  
  =cut
  
  use strict;
  use Carp          ();
  use Params::Util  qw{_STRING _INSTANCE};
  use PPI::Document ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Document';
  }
  
  
  
  
  
  #####################################################################
  # Constructor and Accessors
  
  =pod
  
  =head2 new
  
    my $file = PPI::Document::File->new( 'Module.pm' );
  
  The C<new> constructor works the same as for the regular one, except
  that the only params allowed is a file name. You cannot create an
  "anonymous" PPI::Document::File object, not can you create an empty one.
  
  Returns a new PPI::Document::File object, or C<undef> on error.
  
  =cut
  
  sub new {
  	my $class    = shift;
  	my $filename = _STRING(shift);
  	unless ( defined $filename ) {
  		# Perl::Critic got a complaint about not handling a file
  		# named "0".
  		return $class->_error("Did not provide a file name to load");
  	}
  
  	# Load the Document
  	my $self = $class->SUPER::new( $filename, @_ ) or return undef;
  
  	# Unlike a normal inheritance situation, due to our need to stay
  	# compatible with caching magic, this actually returns a regular
  	# anonymous document. We need to rebless if
  	if ( _INSTANCE($self, 'PPI::Document') ) {
  		bless $self, 'PPI::Document::File';
  	} else {
  		die "PPI::Document::File SUPER call returned an object of the wrong type";
  	}
  
  	# Save the filename
  	$self->{filename} = $filename;
  
  	$self;
  }
  
  =head2 filename
  
  The C<filename> accessor returns the name of the file in which the document
  is stored.
  
  =cut
  
  sub filename {
  	$_[0]->{filename};
  }
  
  =pod
  
  =head2 save
  
    # Save to the file we were loaded from
    $file->save;
    
    # Save a copy to somewhere else
    $file->save( 'Module2.pm' );
  
  The C<save> method works similarly to the one in the parent L<PPI::Document>
  class, saving a copy of the document to a file.
  
  The difference with this subclass is that if C<save> is not passed any
  filename, it will save it back to the file it was loaded from.
  
  Note: When saving to a different file, it is considered to be saving a
  B<copy> and so the value returned by the C<filename> accessor will stay
  the same, and not change to the new filename.
  
  =cut
  
  sub save {
  	my $self = shift;
  
  	# Save to where?
  	my $filename = shift;
  	unless ( defined $filename ) {
  		$filename = $self->filename;
  	}
  
  	# Hand off to main save method
  	$self->SUPER::save( $filename, @_ );
  }
  
  1;
  
  =pod
  
  =head1 TO DO
  
  - May need to overload some methods to forcefully prevent Document
  objects becoming children of another Node.
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_DOCUMENT_FILE

$fatpacked{"PPI/Document/Fragment.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_DOCUMENT_FRAGMENT';
  package PPI::Document::Fragment;
  
  =pod
  
  =head1 NAME
  
  PPI::Document::Fragment - A fragment of a Perl Document
  
  =head1 DESCRIPTION
  
  In some situations you might want to work with a fragment of a larger
  document. C<PPI::Document::Fragment> is a class intended for this purpose.
  It is functionally almost identical to a normal L<PPI::Document>, except
  that it is not possible to get line/column positions for the elements
  within it, and it does not represent a scope.
  
  =head1 METHODS
  
  =cut
  
  use strict;
  use PPI::Document ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Document';
  }
  
  
  
  
  
  #####################################################################
  # PPI::Document Methods
  
  =pod
  
  =head2 index_locations
  
  Unlike when called on a PPI::Document object, you should not be attempting
  to find locations of things within a PPI::Document::Fragment, and thus any
  call to the C<index_locations> will print a warning and return C<undef>
  instead of attempting to index the locations of the Elements.
  
  =cut
  
  # There's no point indexing a fragment
  sub index_locations {
  	warn "Useless attempt to index the locations of a document fragment";
  	undef;
  }
  
  
  
  
  
  #####################################################################
  # PPI::Element Methods
  
  # We are not a scope boundary
  ### XS -> PPI/XS.xs:_PPI_Document_Fragment__scope 0.903+
  sub scope { '' }
  
  1;
  
  =pod
  
  =head1 TO DO
  
  Integrate this into the rest of PPI so it has actual practical uses. The most
  obvious would be to implement arbitrary cut/copy/paste more easily.
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_DOCUMENT_FRAGMENT

$fatpacked{"PPI/Document/Normalized.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_DOCUMENT_NORMALIZED';
  package PPI::Document::Normalized;
  
  =pod
  
  =head1 NAME
  
  PPI::Document::Normalized - A normalized Perl Document
  
  =head1 DESCRIPTION
  
  A C<Normalized Document> object is the result of the normalization process
  contained in the L<PPI::Normal> class. See the documentation for
  L<PPI::Normal> for more information.
  
  The object contains a version stamp and function list for the version
  of L<PPI::Normal> used to create it, and a processed and delinked
  L<PPI::Document> object.
  
  Typically, the Document object will have been mangled by the normalization
  process in a way that would make it fatal to try to actually DO anything
  with it.
  
  Put simply, B<never> use the Document object after normalization.
  B<YOU HAVE BEEN WARNED!>
  
  The object is designed the way it is to provide a bias towards false
  negatives. A comparison between two ::Normalized object will only return
  true if they were produced by the same version of PPI::Normal, with the
  same set of normalization functions (in the same order).
  
  You may get false negatives if you are caching objects across an upgrade.
  
  Please note that this is done for security purposes, as there are many
  cases in which low layer normalization is likely to be done as part of
  a code security process, and false positives could be highly dangerous.
  
  =head1 METHODS
  
  =cut
  
  # For convenience (and since this isn't really a public class), import
  # the methods we will need from Scalar::Util.
  use strict;
  use Scalar::Util qw{refaddr reftype blessed};
  use Params::Util qw{_INSTANCE _ARRAY};
  use PPI::Util    ();
  
  use vars qw{$VERSION};
  BEGIN {
  	$VERSION = '1.215';
  }
  
  use overload 'bool' => \&PPI::Util::TRUE;
  use overload '=='   => 'equal';
  
  
  
  
  
  
  #####################################################################
  # Constructor and Accessors
  
  =pod
  
  =head2 new
  
  The C<new> method is intended for use only by the L<PPI::Normal> class,
  and to get ::Normalized objects, you are highly recommended to use
  either that module, or the C<normalized> method of the L<PPI::Document>
  object itself.
  
  =cut
  
  sub new {
  	my $class = shift;
  	my %args  = @_;
  
  	# Check the required params
  	my $Document  = _INSTANCE($args{Document}, 'PPI::Document') or return undef;
  	my $version   = $args{version} or return undef;
  	my $functions = _ARRAY($args{functions}) or return undef;
  
  	# Create the object
  	my $self = bless {
  		Document  => $Document,
  		version   => $version,
  		functions => $functions,
  		}, $class;
  
  	$self;
  }
  
  sub _Document { $_[0]->{Document}  }
  
  =pod
  
  =head2 version
  
  The C<version> accessor returns the L<PPI::Normal> version used to create
  the object.
  
  =cut
  
  sub version   { $_[0]->{version}   }
  
  =pod
  
  =head2 functions
  
  The C<functions> accessor returns a reference to an array of the
  normalization functions (in order) that were called when creating
  the object.
  
  =cut
  
  sub functions { $_[0]->{functions} }
  
  
  
  
  
  #####################################################################
  # Comparison Methods
  
  =pod
  
  =head2 equal $Normalized
  
  The C<equal> method is the primary comparison method, taking another
  PPI::Document::Normalized object, and checking for equivalence to it.
  
  The C<==> operator is also overload to this method, so that you can
  do something like the following:
  
    my $first  = PPI::Document->load('first.pl');
    my $second = PPI::Document->load('second.pl');
    
    if ( $first->normalized == $second->normalized ) {
    	print "The two documents are equivalent";
    }
  
  Returns true if the normalized documents are equivalent, false if not,
  or C<undef> if there is an error.
  
  =cut
  
  sub equal {
  	my $self  = shift;
  	my $other = _INSTANCE(shift, 'PPI::Document::Normalized') or return undef;
  
  	# Prevent multiple concurrent runs
  	return undef if $self->{processing};
  
  	# Check the version and function list first
  	return '' unless $self->version eq $other->version;
  	$self->_equal_ARRAY( $self->functions, $other->functions ) or return '';
  
  	# Do the main comparison run
  	$self->{seen} = {};
  	my $rv = $self->_equal_blessed( $self->_Document, $other->_Document );
  	delete $self->{seen};
  
  	$rv;
  }
  
  # Check that two objects are matched
  sub _equal_blessed {
  	my ($self, $this, $that) = @_;
  	my ($bthis, $bthat) = (blessed $this, blessed $that);
  	$bthis and $bthat and $bthis eq $bthat or return '';
  
  	# Check the object as a reference
  	$self->_equal_reference( $this, $that );
  }
  
  # Check that two references match their types
  sub _equal_reference {
  	my ($self, $this, $that) = @_;
  	my ($rthis, $rthat) = (refaddr $this, refaddr $that);
  	$rthis and $rthat or return undef;
  
  	# If we have seen this before, are the pointing
  	# is it the same one we saw in both sides
  	my $seen = $self->{seen}->{$rthis};
  	if ( $seen and $seen ne $rthat ) {
  		return '';
  	}
  
  	# Check the reference types
  	my ($tthis, $tthat) = (reftype $this, reftype $that);
  	$tthis and $tthat and $tthis eq $tthat or return undef;
  
  	# Check the children of the reference type
  	$self->{seen}->{$rthis} = $rthat;
  	my $method = "_equal_$tthat";
  	my $rv = $self->$method( $this, $that );
  	delete $self->{seen}->{$rthis};
  	$rv;
  }
  
  # Compare the children of two SCALAR references
  sub _equal_SCALAR {
  	my ($self, $this, $that) = @_;
  	my ($cthis, $cthat) = ($$this, $$that);
  	return $self->_equal_blessed( $cthis, $cthat )   if blessed $cthis;
  	return $self->_equal_reference( $cthis, $cthat ) if ref $cthis;
  	return (defined $cthat and $cthis eq $cthat)     if defined $cthis;
  	! defined $cthat;
  }
  
  # For completeness sake, lets just treat REF as a specialist SCALAR case
  sub _equal_REF { shift->_equal_SCALAR(@_) }
  
  # Compare the children of two ARRAY references
  sub _equal_ARRAY {
  	my ($self, $this, $that) = @_;
  
  	# Compare the number of elements
  	scalar(@$this) == scalar(@$that) or return '';
  
  	# Check each element in the array.
  	# Descend depth-first.
  	foreach my $i ( 0 .. scalar(@$this) ) {
  		my ($cthis, $cthat) = ($this->[$i], $that->[$i]);
  		if ( blessed $cthis ) {
  			return '' unless $self->_equal_blessed( $cthis, $cthat );
  		} elsif ( ref $cthis ) {
  			return '' unless $self->_equal_reference( $cthis, $cthat );
  		} elsif ( defined $cthis ) {
  			return '' unless (defined $cthat and $cthis eq $cthat);
  		} else {
  			return '' if defined $cthat;
  		}
  	}
  
  	1;
  }
  
  # Compare the children of a HASH reference
  sub _equal_HASH {
  	my ($self, $this, $that) = @_;
  
  	# Compare the number of keys
  	return '' unless scalar(keys %$this) == scalar(keys %$that);
  
  	# Compare each key, descending depth-first.
  	foreach my $k ( keys %$this ) {
  		return '' unless exists $that->{$k};
  		my ($cthis, $cthat) = ($this->{$k}, $that->{$k});
  		if ( blessed $cthis ) {
  			return '' unless $self->_equal_blessed( $cthis, $cthat );
  		} elsif ( ref $cthis ) {
  			return '' unless $self->_equal_reference( $cthis, $cthat );
  		} elsif ( defined $cthis ) {
  			return '' unless (defined $cthat and $cthis eq $cthat);
  		} else {
  			return '' if defined $cthat;
  		}
  	}
  
  	1;
  }		
  
  # We do not support GLOB comparisons
  sub _equal_GLOB {
  	my ($self, $this, $that) = @_;
  	warn('GLOB comparisons are not supported');
  	'';
  }
  
  # We do not support CODE comparisons
  sub _equal_CODE {
  	my ($self, $this, $that) = @_;
  	refaddr $this == refaddr $that;
  }
  
  # We don't support IO comparisons
  sub _equal_IO {
  	my ($self, $this, $that) = @_;
  	warn('IO comparisons are not supported');
  	'';
  }
  
  sub DESTROY {
  	# Take the screw up Document with us
  	if ( $_[0]->{Document} ) {
  		$_[0]->{Document}->DESTROY;
  		delete $_[0]->{Document};
  	}
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2005 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
  	
PPI_DOCUMENT_NORMALIZED

$fatpacked{"PPI/Dumper.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_DUMPER';
  package PPI::Dumper;
  
  =pod
  
  =head1 NAME
  
  PPI::Dumper - Dumping of PDOM trees
  
  =head1 SYNOPSIS
  
    # Load a document
    my $Module = PPI::Document->new( 'MyModule.pm' );
    
    # Create the dumper
    my $Dumper = PPI::Dumper->new( $Module );
    
    # Dump the document
    $Dumper->print;
  
  =head1 DESCRIPTION
  
  The PDOM trees in PPI are quite complex, and getting a dump of their
  structure for development and debugging purposes is important.
  
  This module provides that functionality.
  
  The process is relatively simple. Create a dumper object with a
  particular set of options, and then call one of the dump methods to
  generate the dump content itself.
  
  =head1 METHODS
  
  =cut
  
  use strict;
  use Params::Util qw{_INSTANCE};
  
  use vars qw{$VERSION};
  BEGIN {
  	$VERSION = '1.215';
  }
  
  
  
  
  
  #####################################################################
  # Constructor
  
  =pod
  
  =head2 new $Element, param => value, ...
  
  The C<new> constructor creates a dumper, and takes as argument a single
  L<PPI::Element> object of any type to serve as the root of the tree to
  be dumped, and a number of key-E<gt>value parameters to control the output
  format of the Dumper. Details of the parameters are listed below.
  
  Returns a new C<PPI::Dumper> object, or C<undef> if the constructor
  is not passed a correct L<PPI::Element> root object.
  
  =over
  
  =item memaddr
  
  Should the dumper print the memory addresses of each PDOM element.
  True/false value, off by default.
  
  =item indent
  
  Should the structures being dumped be indented. This value is numeric,
  with the number representing the number of spaces to use when indenting
  the dumper output. Set to '2' by default.
  
  =item class
  
  Should the dumper print the full class for each element.
  True/false value, on by default.
  
  =item content
  
  Should the dumper show the content of each element. True/false value,
  on by default.
  
  =item whitespace
  
  Should the dumper show whitespace tokens. By not showing the copious
  numbers of whitespace tokens the structure of the code can often be
  made much clearer. True/false value, on by default.
  
  =item comments
  
  Should the dumper show comment tokens. In situations where you have
  a lot of comments, the code can often be made clearer by ignoring
  comment tokens. True/value value, on by default.
  
  =item locations
  
  Should the dumper show the location of each token. The values shown are
  [ line, rowchar, column ]. See L<PPI::Element/"location"> for a description of
  what these values really are. True/false value, off by default.
  
  =back
  
  =cut
  
  sub new {
  	my $class   = shift;
  	my $Element = _INSTANCE(shift, 'PPI::Element') or return undef;
  
  	# Create the object
  	my $self = bless {
  		root    => $Element,
  		display => {
  			memaddr    => '', # Show the refaddr of the item
  			indent     => 2,  # Indent the structures
  			class      => 1,  # Show the object class
  			content    => 1,  # Show the object contents
  			whitespace => 1,  # Show whitespace tokens
  			comments   => 1,  # Show comment tokens
  			locations  => 0,  # Show token locations
  			},
  		}, $class;
  
  	# Handle the options
  	my %options = map { lc $_ } @_;
  	foreach ( keys %{$self->{display}} ) {
  		if ( exists $options{$_} ) {
  			if ( $_ eq 'indent' ) {
  				$self->{display}->{indent} = $options{$_};
  			} else {
  				$self->{display}->{$_} = !! $options{$_};
  			}
  		}
  	}
  
  	$self->{indent_string} = join '', (' ' x $self->{display}->{indent});
  
  	$self;
  }
  
  
  
  
  
  #####################################################################
  # Main Interface Methods
  
  =pod
  
  =head2 print
  
  The C<print> method generates the dump and prints it to STDOUT.
  
  Returns as for the internal print function.
  
  =cut
  
  sub print {
  	CORE::print(shift->string);
  }
  
  =pod
  
  =head2 string
  
  The C<string> method generates the dump and provides it as a
  single string.
  
  Returns a string or undef if there is an error while generating the dump. 
  
  =cut
  
  sub string {
  	my $array_ref = shift->_dump or return undef;
  	join '', map { "$_\n" } @$array_ref;
  }
  
  =pod
  
  =head2 list
  
  The C<list> method generates the dump and provides it as a raw
  list, without trailing newlines.
  
  Returns a list or the null list if there is an error while generation
  the dump.
  
  =cut
  
  sub list {
  	my $array_ref = shift->_dump or return ();
  	@$array_ref;
  }
  
  
  
  
  
  #####################################################################
  # Generation Support Methods
  
  sub _dump {
  	my $self    = ref $_[0] ? shift : shift->new(shift);
  	my $Element = _INSTANCE($_[0], 'PPI::Element') ? shift : $self->{root};
  	my $indent  = shift || '';
  	my $output  = shift || [];
  
  	# Print the element if needed
  	my $show = 1;
  	if ( $Element->isa('PPI::Token::Whitespace') ) {
  		$show = 0 unless $self->{display}->{whitespace};
  	} elsif ( $Element->isa('PPI::Token::Comment') ) {
  		$show = 0 unless $self->{display}->{comments};
  	}
  	push @$output, $self->_element_string( $Element, $indent ) if $show;
  
  	# Recurse into our children
  	if ( $Element->isa('PPI::Node') ) {
  		my $child_indent = $indent . $self->{indent_string};
  		foreach my $child ( @{$Element->{children}} ) {
  			$self->_dump( $child, $child_indent, $output );
  		}
  	}
  
  	$output;
  }
  
  sub _element_string {
  	my $self    = ref $_[0] ? shift : shift->new(shift);
  	my $Element = _INSTANCE($_[0], 'PPI::Element') ? shift : $self->{root};
  	my $indent  = shift || '';
  	my $string  = '';
  
  	# Add the memory location
  	if ( $self->{display}->{memaddr} ) {
  		$string .= $Element->refaddr . '  ';
  	}
          
          # Add the location if such exists
  	if ( $self->{display}->{locations} ) {
  		my $loc_string;
  		if ( $Element->isa('PPI::Token') ) {
  			my $location = $Element->location;
  			if ($location) {
  				$loc_string = sprintf("[ % 4d, % 3d, % 3d ] ", @$location);
  			}
  		}
  		# Output location or pad with 20 spaces
  		$string .= $loc_string || " " x 20;
  	}
          
  	# Add the indent
  	if ( $self->{display}->{indent} ) {
  		$string .= $indent;
  	}
  
  	# Add the class name
  	if ( $self->{display}->{class} ) {
  		$string .= ref $Element;
  	}
  
  	if ( $Element->isa('PPI::Token') ) {
  		# Add the content
  		if ( $self->{display}->{content} ) {
  			my $content = $Element->content;
  			$content =~ s/\n/\\n/g;
  			$content =~ s/\t/\\t/g;
  			$string .= "  \t'$content'";
  		}
  
  	} elsif ( $Element->isa('PPI::Structure') ) {
  		# Add the content
  		if ( $self->{display}->{content} ) {
  			my $start = $Element->start
  				? $Element->start->content
  				: '???';
  			my $finish = $Element->finish
  				? $Element->finish->content
  				: '???';
  			$string .= "  \t$start ... $finish";
  		}
  	}
  	
  	$string;
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_DUMPER

$fatpacked{"PPI/Element.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_ELEMENT';
  package PPI::Element;
  
  =pod
  
  =head1 NAME
  
  PPI::Element - The abstract Element class, a base for all source objects
  
  =head1 INHERITANCE
  
    PPI::Element is the root of the PDOM tree
  
  =head1 DESCRIPTION
  
  The abstract C<PPI::Element> serves as a base class for all source-related
  objects, from a single whitespace token to an entire document. It provides
  a basic set of methods to provide a common interface and basic
  implementations.
  
  =head1 METHODS
  
  =cut
  
  use strict;
  use Clone           ();
  use Scalar::Util    qw{refaddr};
  use Params::Util    qw{_INSTANCE _ARRAY};
  use List::MoreUtils ();
  use PPI::Util       ();
  use PPI::Node       ();
  
  use vars qw{$VERSION $errstr %_PARENT};
  BEGIN {
  	$VERSION = '1.215';
  	$errstr  = '';
  
  	# Master Child -> Parent index
  	%_PARENT = ();
  }
  
  use overload 'bool' => \&PPI::Util::TRUE;
  use overload '""'   => 'content';
  use overload '=='   => '__equals';
  use overload '!='   => '__nequals';
  use overload 'eq'   => '__eq';
  use overload 'ne'   => '__ne';
  
  
  
  
  
  #####################################################################
  # General Properties
  
  =pod
  
  =head2 significant
  
  Because we treat whitespace and other non-code items as Tokens (in order to
  be able to "round trip" the L<PPI::Document> back to a file) the
  C<significant> method allows us to distinguish between tokens that form a
  part of the code, and tokens that aren't significant, such as whitespace,
  POD, or the portion of a file after (and including) the C<__END__> token.
  
  Returns true if the Element is significant, or false it not.
  
  =cut
  
  ### XS -> PPI/XS.xs:_PPI_Element__significant 0.845+
  sub significant { 1 }
  
  =pod
  
  =head2 class
  
  The C<class> method is provided as a convenience, and really does nothing
  more than returning C<ref($self)>. However, some people have found that
  they appreciate the laziness of C<$Foo-E<gt>class eq 'whatever'>, so I
  have caved to popular demand and included it.
  
  Returns the class of the Element as a string
  
  =cut
  
  sub class { ref($_[0]) }
  
  =pod
  
  =head2 tokens
  
  The C<tokens> method returns a list of L<PPI::Token> objects for the
  Element, essentially getting back that part of the document as if it had
  not been lexed.
  
  This also means there are no Statements and no Structures in the list,
  just the Token classes.
  
  =cut
  
  sub tokens { $_[0] }
  
  =pod
  
  =head2 content
  
  For B<any> C<PPI::Element>, the C<content> method will reconstitute the
  base code for it as a single string. This method is also the method used
  for overloading stringification. When an Element is used in a double-quoted
  string for example, this is the method that is called.
  
  B<WARNING:>
  
  You should be aware that because of the way that here-docs are handled, any
  here-doc content is not included in C<content>, and as such you should
  B<not> eval or execute the result if it contains any L<PPI::Token::HereDoc>.
  
  The L<PPI::Document> method C<serialize> should be used to stringify a PDOM
  document into something that can be executed as expected.
  
  Returns the basic code as a string (excluding here-doc content).
  
  =cut
  
  ### XS -> PPI/XS.xs:_PPI_Element__content 0.900+
  sub content { '' }
  
  
  
  
  
  #####################################################################
  # Naigation Methods
  
  =pod
  
  =head2 parent
  
  Elements themselves are not intended to contain other Elements, that is
  left to the L<PPI::Node> abstract class, a subclass of C<PPI::Element>.
  However, all Elements can be contained B<within> a parent Node.
  
  If an Element is within a parent Node, the C<parent> method returns the
  Node.
  
  =cut
  
  sub parent { $_PARENT{refaddr $_[0]} }
  
  =pod
  
  =head2 descendant_of $element
  
  Answers whether a C<PPI::Element> is contained within another one.
  
  C<PPI::Element>s are considered to be descendants of themselves.
  
  =begin testing descendant_of 9
  
  my $Document = PPI::Document->new( \'( [ thingy ] ); $blarg = 1' );
  isa_ok( $Document, 'PPI::Document' );
  ok(
  	$Document->descendant_of($Document),
  	'Document is a descendant of itself.',
  );
  
  my $words = $Document->find('Token::Word');
  is(scalar @{$words}, 1, 'Document contains 1 Word.');
  my $word = $words->[0];
  ok(
  	$word->descendant_of($word),
  	'Word is a descendant of itself.',
  );
  ok(
  	$word->descendant_of($Document),
  	'Word is a descendant of the Document.',
  );
  ok(
  	! $Document->descendant_of($word),
  	'Document is not a descendant of the Word.',
  );
  
  my $symbols = $Document->find('Token::Symbol');
  is(scalar @{$symbols}, 1, 'Document contains 1 Symbol.');
  my $symbol = $symbols->[0];
  ok(
  	! $word->descendant_of($symbol),
  	'Word is not a descendant the Symbol.',
  );
  ok(
  	! $symbol->descendant_of($word),
  	'Symbol is not a descendant the Word.',
  );
  
  =end testing
  
  =cut
  
  sub descendant_of {
  	my $cursor = shift;
  	my $parent = shift or return undef;
  	while ( refaddr $cursor != refaddr $parent ) {
  		$cursor = $_PARENT{refaddr $cursor} or return '';
  	}
  	return 1;
  }
  
  =pod
  
  =head2 ancestor_of $element
  
  Answers whether a C<PPI::Element> is contains another one.
  
  C<PPI::Element>s are considered to be ancestors of themselves.
  
  =begin testing ancestor_of 9
  
  my $Document = PPI::Document->new( \'( [ thingy ] ); $blarg = 1' );
  isa_ok( $Document, 'PPI::Document' );
  ok(
  	$Document->ancestor_of($Document),
  	'Document is an ancestor of itself.',
  );
  
  my $words = $Document->find('Token::Word');
  is(scalar @{$words}, 1, 'Document contains 1 Word.');
  my $word = $words->[0];
  ok(
  	$word->ancestor_of($word),
  	'Word is an ancestor of itself.',
  );
  ok(
  	! $word->ancestor_of($Document),
  	'Word is not an ancestor of the Document.',
  );
  ok(
  	$Document->ancestor_of($word),
  	'Document is an ancestor of the Word.',
  );
  
  my $symbols = $Document->find('Token::Symbol');
  is(scalar @{$symbols}, 1, 'Document contains 1 Symbol.');
  my $symbol = $symbols->[0];
  ok(
  	! $word->ancestor_of($symbol),
  	'Word is not an ancestor the Symbol.',
  );
  ok(
  	! $symbol->ancestor_of($word),
  	'Symbol is not an ancestor the Word.',
  );
  
  =end testing
  
  =cut
  
  sub ancestor_of {
  	my $self   = shift;
  	my $cursor = shift or return undef;
  	while ( refaddr $cursor != refaddr $self ) {
  		$cursor = $_PARENT{refaddr $cursor} or return '';
  	}
  	return 1;
  }
  
  =pod
  
  =head2 statement
  
  For a C<PPI::Element> that is contained (at some depth) within a
  L<PPI::Statment>, the C<statement> method will return the first parent
  Statement object lexically 'above' the Element.
  
  Returns a L<PPI::Statement> object, which may be the same Element if the
  Element is itself a L<PPI::Statement> object.
  
  Returns false if the Element is not within a Statement and is not itself
  a Statement.
  
  =cut
  
  sub statement {
  	my $cursor = shift;
  	while ( ! _INSTANCE($cursor, 'PPI::Statement') ) {
  		$cursor = $_PARENT{refaddr $cursor} or return '';
  	}
  	$cursor;
  }
  
  =pod
  
  =head2 top
  
  For a C<PPI::Element> that is contained within a PDOM tree, the C<top> method
  will return the top-level Node in the tree. Most of the time this should be
  a L<PPI::Document> object, however this will not always be so. For example,
  if a subroutine has been removed from its Document, to be moved to another
  Document.
  
  Returns the top-most PDOM object, which may be the same Element, if it is
  not within any parent PDOM object.
  
  =cut
  
  sub top {
  	my $cursor = shift;
  	while ( my $parent = $_PARENT{refaddr $cursor} ) {
  		$cursor = $parent;
  	}
  	$cursor;
  }
  
  =pod
  
  =head2 document
  
  For an Element that is contained within a L<PPI::Document> object,
  the C<document> method will return the top-level Document for the Element.
  
  Returns the L<PPI::Document> for this Element, or false if the Element is not
  contained within a Document.
  
  =cut
  
  sub document {
  	my $top = shift->top;
  	_INSTANCE($top, 'PPI::Document') and $top;
  }
  
  =pod
  
  =head2 next_sibling
  
  All L<PPI::Node> objects (specifically, our parent Node) contain a number of
  C<PPI::Element> objects. The C<next_sibling> method returns the C<PPI::Element>
  immediately after the current one, or false if there is no next sibling.
  
  =cut
  
  sub next_sibling {
  	my $self     = shift;
  	my $parent   = $_PARENT{refaddr $self} or return '';
  	my $key      = refaddr $self;
  	my $elements = $parent->{children};
  	my $position = List::MoreUtils::firstidx {
  		refaddr $_ == $key
  		} @$elements;
  	$elements->[$position + 1] || '';
  }
  
  =pod
  
  =head2 snext_sibling
  
  As per the other 's' methods, the C<snext_sibling> method returns the next
  B<significant> sibling of the C<PPI::Element> object.
  
  Returns a C<PPI::Element> object, or false if there is no 'next' significant
  sibling.
  
  =cut
  
  sub snext_sibling {
  	my $self     = shift;
  	my $parent   = $_PARENT{refaddr $self} or return '';
  	my $key      = refaddr $self;
  	my $elements = $parent->{children};
  	my $position = List::MoreUtils::firstidx {
  		refaddr $_ == $key
  		} @$elements;
  	while ( defined(my $it = $elements->[++$position]) ) {
  		return $it if $it->significant;
  	}
  	'';
  }
  
  =pod
  
  =head2 previous_sibling
  
  All L<PPI::Node> objects (specifically, our parent Node) contain a number of
  C<PPI::Element> objects. The C<previous_sibling> method returns the Element
  immediately before the current one, or false if there is no 'previous'
  C<PPI::Element> object.
  
  =cut
  
  sub previous_sibling {
  	my $self     = shift;
  	my $parent   = $_PARENT{refaddr $self} or return '';
  	my $key      = refaddr $self;
  	my $elements = $parent->{children};
  	my $position = List::MoreUtils::firstidx {
  		refaddr $_ == $key
  		} @$elements;
  	$position and $elements->[$position - 1] or '';
  }
  
  =pod
  
  =head2 sprevious_sibling
  
  As per the other 's' methods, the C<sprevious_sibling> method returns
  the previous B<significant> sibling of the C<PPI::Element> object.
  
  Returns a C<PPI::Element> object, or false if there is no 'previous' significant
  sibling.
  
  =cut
  
  sub sprevious_sibling {
  	my $self     = shift;
  	my $parent   = $_PARENT{refaddr $self} or return '';
  	my $key      = refaddr $self;
  	my $elements = $parent->{children};
  	my $position = List::MoreUtils::firstidx {
  		refaddr $_ == $key
  		} @$elements;
  	while ( $position-- and defined(my $it = $elements->[$position]) ) {
  		return $it if $it->significant;
  	}
  	'';
  }
  
  =pod
  
  =head2 first_token
  
  As a support method for higher-order algorithms that deal specifically with
  tokens and actual Perl content, the C<first_token> method finds the first
  PPI::Token object within or equal to this one.
  
  That is, if called on a L<PPI::Node> subclass, it will descend until it
  finds a L<PPI::Token>. If called on a L<PPI::Token> object, it will return
  the same object.
  
  Returns a L<PPI::Token> object, or dies on error (which should be extremely
  rare and only occur if an illegal empty L<PPI::Statement> exists below the
  current Element somewhere.
  
  =cut
  
  sub first_token {
  	my $cursor = shift;
  	while ( $cursor->isa('PPI::Node') ) {
  		$cursor = $cursor->first_element
  		or die "Found empty PPI::Node while getting first token";
  	}
  	$cursor;
  }
  
  
  =pod
  
  =head2 last_token
  
  As a support method for higher-order algorithms that deal specifically with
  tokens and actual Perl content, the C<last_token> method finds the last
  PPI::Token object within or equal to this one.
  
  That is, if called on a L<PPI::Node> subclass, it will descend until it
  finds a L<PPI::Token>. If called on a L<PPI::Token> object, it will return
  the itself.
  
  Returns a L<PPI::Token> object, or dies on error (which should be extremely
  rare and only occur if an illegal empty L<PPI::Statement> exists below the
  current Element somewhere.
  
  =cut
  
  sub last_token {
  	my $cursor = shift;
  	while ( $cursor->isa('PPI::Node') ) {
  		$cursor = $cursor->last_element
  		or die "Found empty PPI::Node while getting first token";
  	}
  	$cursor;
  }
  
  =pod
  
  =head2 next_token
  
  As a support method for higher-order algorithms that deal specifically with
  tokens and actual Perl content, the C<next_token> method finds the
  L<PPI::Token> object that is immediately after the current Element, even if
  it is not within the same parent L<PPI::Node> as the one for which the
  method is being called.
  
  Note that this is B<not> defined as a L<PPI::Token>-specific method,
  because it can be useful to find the next token that is after, say, a
  L<PPI::Statement>, although obviously it would be useless to want the
  next token after a L<PPI::Document>.
  
  Returns a L<PPI::Token> object, or false if there are no more tokens after
  the Element.
  
  =cut
  
  sub next_token {
  	my $cursor = shift;
  
  	# Find the next element, going upwards as needed
  	while ( 1 ) {
  		my $element = $cursor->next_sibling;
  		if ( $element ) {
  			return $element if $element->isa('PPI::Token');
  			return $element->first_token;
  		}
  		$cursor = $cursor->parent or return '';
  		if ( $cursor->isa('PPI::Structure') and $cursor->finish ) {
  			return $cursor->finish;
  		}
  	}
  }
  
  =pod
  
  =head2 previous_token
  
  As a support method for higher-order algorithms that deal specifically with
  tokens and actual Perl content, the C<previous_token> method finds the
  L<PPI::Token> object that is immediately before the current Element, even
  if it is not within the same parent L<PPI::Node> as this one.
  
  Note that this is not defined as a L<PPI::Token>-only method, because it can
  be useful to find the token is before, say, a L<PPI::Statement>, although
  obviously it would be useless to want the next token before a
  L<PPI::Document>.
  
  Returns a L<PPI::Token> object, or false if there are no more tokens before
  the C<Element>.
  
  =cut
  
  sub previous_token {
  	my $cursor = shift;
  
  	# Find the previous element, going upwards as needed
  	while ( 1 ) {
  		my $element = $cursor->previous_sibling;
  		if ( $element ) {
  			return $element if $element->isa('PPI::Token');
  			return $element->last_token;
  		}
  		$cursor = $cursor->parent or return '';
  		if ( $cursor->isa('PPI::Structure') and $cursor->start ) {
  			return $cursor->start;
  		}
  	}
  }
  
  
  
  
  
  #####################################################################
  # Manipulation
  
  =pod
  
  =head2 clone
  
  As per the L<Clone> module, the C<clone> method makes a perfect copy of
  an Element object. In the generic case, the implementation is done using
  the L<Clone> module's mechanism itself. In higher-order cases, such as for
  Nodes, there is more work involved to keep the parent-child links intact.
  
  =cut
  
  sub clone {
  	Clone::clone(shift);
  }
  
  =pod
  
  =head2 insert_before @Elements
  
  The C<insert_before> method allows you to insert lexical perl content, in
  the form of C<PPI::Element> objects, before the calling C<Element>. You
  need to be very careful when modifying perl code, as it's easy to break
  things.
  
  In its initial incarnation, this method allows you to insert a single
  Element, and will perform some basic checking to prevent you inserting
  something that would be structurally wrong (in PDOM terms).
  
  In future, this method may be enhanced to allow the insertion of multiple
  Elements, inline-parsed code strings or L<PPI::Document::Fragment> objects.
  
  Returns true if the Element was inserted, false if it can not be inserted,
  or C<undef> if you do not provide a L<PPI::Element> object as a parameter.
  
  =begin testing __insert_before 6
  
  my $Document = PPI::Document->new( \"print 'Hello World';" );
  isa_ok( $Document, 'PPI::Document' );
  my $semi = $Document->find_first('Token::Structure');
  isa_ok( $semi, 'PPI::Token::Structure' );
  is( $semi->content, ';', 'Got expected token' );
  my $foo = PPI::Token::Word->new('foo');
  isa_ok( $foo, 'PPI::Token::Word' );
  is( $foo->content, 'foo', 'Created Word token' );
  $semi->__insert_before( $foo );
  is( $Document->serialize, "print 'Hello World'foo;",
  	'__insert_before actually inserts' );
  
  =end testing
  
  =begin testing insert_before after __insert_before 6
  
  my $Document = PPI::Document->new( \"print 'Hello World';" );
  isa_ok( $Document, 'PPI::Document' );
  my $semi = $Document->find_first('Token::Structure');
  isa_ok( $semi, 'PPI::Token::Structure' );
  is( $semi->content, ';', 'Got expected token' );
  my $foo = PPI::Token::Word->new('foo');
  isa_ok( $foo, 'PPI::Token::Word' );
  is( $foo->content, 'foo', 'Created Word token' );
  $semi->insert_before( $foo );
  is( $Document->serialize, "print 'Hello World'foo;",
  	'insert_before actually inserts' );
  
  =end testing
  
  =cut
  
  sub __insert_before {
  	my $self = shift;
  	$self->parent->__insert_before_child( $self, @_ );
  }
  
  =pod
  
  =head2 insert_after @Elements
  
  The C<insert_after> method allows you to insert lexical perl content, in
  the form of C<PPI::Element> objects, after the calling C<Element>. You need
  to be very careful when modifying perl code, as it's easy to break things.
  
  In its initial incarnation, this method allows you to insert a single
  Element, and will perform some basic checking to prevent you inserting
  something that would be structurally wrong (in PDOM terms).
  
  In future, this method may be enhanced to allow the insertion of multiple
  Elements, inline-parsed code strings or L<PPI::Document::Fragment> objects.
  
  Returns true if the Element was inserted, false if it can not be inserted,
  or C<undef> if you do not provide a L<PPI::Element> object as a parameter.
  
  =begin testing __insert_after 6
  
  my $Document = PPI::Document->new( \"print 'Hello World';" );
  isa_ok( $Document, 'PPI::Document' );
  my $string = $Document->find_first('Token::Quote');
  isa_ok( $string, 'PPI::Token::Quote' );
  is( $string->content, "'Hello World'", 'Got expected token' );
  my $foo = PPI::Token::Word->new('foo');
  isa_ok( $foo, 'PPI::Token::Word' );
  is( $foo->content, 'foo', 'Created Word token' );
  $string->__insert_after( $foo );
  is( $Document->serialize, "print 'Hello World'foo;",
  	'__insert_after actually inserts' );
  
  =end testing
  
  =begin testing insert_after after __insert_after 6
  
  my $Document = PPI::Document->new( \"print 'Hello World';" );
  isa_ok( $Document, 'PPI::Document' );
  my $string = $Document->find_first('Token::Quote');
  isa_ok( $string, 'PPI::Token::Quote' );
  is( $string->content, "'Hello World'", 'Got expected token' );
  my $foo = PPI::Token::Word->new('foo');
  isa_ok( $foo, 'PPI::Token::Word' );
  is( $foo->content, 'foo', 'Created Word token' );
  $string->insert_after( $foo );
  is( $Document->serialize, "print 'Hello World'foo;",
  	'insert_after actually inserts' );
  
  =end testing
  
  =cut
  
  sub __insert_after {
  	my $self = shift;
  	$self->parent->__insert_after_child( $self, @_ );
  }
  
  =pod
  
  =head2 remove
  
  For a given C<PPI::Element>, the C<remove> method will remove it from its
  parent B<intact>, along with all of its children.
  
  Returns the C<Element> itself as a convenience, or C<undef> if an error
  occurs while trying to remove the C<Element>.
  
  =cut
  
  sub remove {
  	my $self   = shift;
  	my $parent = $self->parent or return $self;
  	$parent->remove_child( $self );
  }
  
  =pod
  
  =head2 delete
  
  For a given C<PPI::Element>, the C<delete> method will remove it from its
  parent, immediately deleting the C<Element> and all of its children (if it
  has any).
  
  Returns true if the C<Element> was successfully deleted, or C<undef> if
  an error occurs while trying to remove the C<Element>.
  
  =cut
  
  sub delete {
  	$_[0]->remove or return undef;
  	$_[0]->DESTROY;
  	1;
  }
  
  =pod
  
  =head2 replace $Element
  
  Although some higher level class support more exotic forms of replace,
  at the basic level the C<replace> method takes a single C<Element> as
  an argument and replaces the current C<Element> with it.
  
  To prevent accidental damage to code, in this initial implementation the
  replacement element B<must> be of the same class (or a subclass) as the
  one being replaced.
  
  =cut
  
  sub replace {
  	my $self    = ref $_[0] ? shift : return undef;
  	my $Element = _INSTANCE(shift, ref $self) or return undef;
  	die "The ->replace method has not yet been implemented";
  }
  
  =pod
  
  =head2 location
  
  If the Element exists within a L<PPI::Document> that has
  indexed the Element locations using C<PPI::Document::index_locations>, the
  C<location> method will return the location of the first character of the
  Element within the Document.
  
  Returns the location as a reference to a five-element array in the form C<[
  $line, $rowchar, $col, $logical_line, $logical_file_name ]>. The values are in
  a human format, with the first character of the file located at C<[ 1, 1, 1, ?,
  'something' ]>.
  
  The second and third numbers are similar, except that the second is the
  literal horizontal character, and the third is the visual column, taking
  into account tabbing (see L<PPI::Document/"tab_width [ $width ]">).
  
  The fourth number is the line number, taking into account any C<#line>
  directives.  The fifth element is the name of the file that the element was
  found in, if available, taking into account any C<#line> directives.
  
  Returns C<undef> on error, or if the L<PPI::Document> object has not been
  indexed.
  
  =cut
  
  sub location {
  	my $self = shift;
  
  	$self->_ensure_location_present or return undef;
  
  	# Return a copy, not the original
  	return [ @{$self->{_location}} ];
  }
  
  =pod
  
  =head2 line_number
  
  If the Element exists within a L<PPI::Document> that has indexed the Element
  locations using C<PPI::Document::index_locations>, the C<line_number> method
  will return the line number of the first character of the Element within the
  Document.
  
  Returns C<undef> on error, or if the L<PPI::Document> object has not been
  indexed.
  
  =begin testing line_number 3
  
  my $document = PPI::Document->new(\<<'END_PERL');
  
  
     foo
  END_PERL
  
  isa_ok( $document, 'PPI::Document' );
  my $words = $document->find('PPI::Token::Word');
  is( scalar @{$words}, 1, 'Found expected word token.' );
  is( $words->[0]->line_number, 3, 'Got correct line number.' );
  
  =end testing
  
  =cut
  
  sub line_number {
  	my $self = shift;
  
  	my $location = $self->location() or return undef;
  	return $location->[0];
  }
  
  =pod
  
  =head2 column_number
  
  If the Element exists within a L<PPI::Document> that has indexed the Element
  locations using C<PPI::Document::index_locations>, the C<column_number> method
  will return the column number of the first character of the Element within the
  Document.
  
  Returns C<undef> on error, or if the L<PPI::Document> object has not been
  indexed.
  
  =begin testing column_number 3
  
  my $document = PPI::Document->new(\<<'END_PERL');
  
  
     foo
  END_PERL
  
  isa_ok( $document, 'PPI::Document' );
  my $words = $document->find('PPI::Token::Word');
  is( scalar @{$words}, 1, 'Found expected word token.' );
  is( $words->[0]->column_number, 4, 'Got correct column number.' );
  
  =end testing
  
  =cut
  
  sub column_number {
  	my $self = shift;
  
  	my $location = $self->location() or return undef;
  	return $location->[1];
  }
  
  =pod
  
  =head2 visual_column_number
  
  If the Element exists within a L<PPI::Document> that has indexed the Element
  locations using C<PPI::Document::index_locations>, the C<visual_column_number>
  method will return the visual column number of the first character of the
  Element within the Document, according to the value of
  L<PPI::Document/"tab_width [ $width ]">.
  
  Returns C<undef> on error, or if the L<PPI::Document> object has not been
  indexed.
  
  =begin testing visual_column_number 3
  
  my $document = PPI::Document->new(\<<"END_PERL");
  
  
  \t foo
  END_PERL
  
  isa_ok( $document, 'PPI::Document' );
  my $tab_width = 5;
  $document->tab_width($tab_width);  # don't use a "usual" value.
  my $words = $document->find('PPI::Token::Word');
  is( scalar @{$words}, 1, 'Found expected word token.' );
  is(
  	$words->[0]->visual_column_number,
  	$tab_width + 2,
  	'Got correct visual column number.',
  );
  
  =end testing
  
  =cut
  
  sub visual_column_number {
  	my $self = shift;
  
  	my $location = $self->location() or return undef;
  	return $location->[2];
  }
  
  =pod
  
  =head2 logical_line_number
  
  If the Element exists within a L<PPI::Document> that has indexed the Element
  locations using C<PPI::Document::index_locations>, the C<logical_line_number>
  method will return the line number of the first character of the Element within
  the Document, taking into account any C<#line> directives.
  
  Returns C<undef> on error, or if the L<PPI::Document> object has not been
  indexed.
  
  =begin testing logical_line_number 3
  
  # Double quoted so that we don't really have a "#line" at the beginning and
  # errors in this file itself aren't affected by this.
  my $document = PPI::Document->new(\<<"END_PERL");
  
  
  \#line 1 test-file
     foo
  END_PERL
  
  isa_ok( $document, 'PPI::Document' );
  my $words = $document->find('PPI::Token::Word');
  is( scalar @{$words}, 1, 'Found expected word token.' );
  is( $words->[0]->logical_line_number, 1, 'Got correct logical line number.' );
  
  =end testing
  
  =cut
  
  sub logical_line_number {
  	my $self = shift;
  
  	return $self->location()->[3];
  }
  
  =pod
  
  =head2 logical_filename
  
  If the Element exists within a L<PPI::Document> that has indexed the Element
  locations using C<PPI::Document::index_locations>, the C<logical_filename>
  method will return the logical file name containing the first character of the
  Element within the Document, taking into account any C<#line> directives.
  
  Returns C<undef> on error, or if the L<PPI::Document> object has not been
  indexed.
  
  =begin testing logical_filename 3
  
  # Double quoted so that we don't really have a "#line" at the beginning and
  # errors in this file itself aren't affected by this.
  my $document = PPI::Document->new(\<<"END_PERL");
  
  
  \#line 1 test-file
     foo
  END_PERL
  
  isa_ok( $document, 'PPI::Document' );
  my $words = $document->find('PPI::Token::Word');
  is( scalar @{$words}, 1, 'Found expected word token.' );
  is(
  	$words->[0]->logical_filename,
  	'test-file',
  	'Got correct logical line number.',
  );
  
  =end testing
  
  =cut
  
  sub logical_filename {
  	my $self = shift;
  
  	my $location = $self->location() or return undef;
  	return $location->[4];
  }
  
  sub _ensure_location_present {
  	my $self = shift;
  
  	unless ( exists $self->{_location} ) {
  		# Are we inside a normal document?
  		my $Document = $self->document or return undef;
  		if ( $Document->isa('PPI::Document::Fragment') ) {
  			# Because they can't be serialized, document fragments
  			# do not support the concept of location.
  			return undef;
  		}
  
  		# Generate the locations. If they need one location, then
  		# the chances are they'll want more, and it's better that
  		# everything is already pre-generated.
  		$Document->index_locations or return undef;
  		unless ( exists $self->{_location} ) {
  			# erm... something went very wrong here
  			return undef;
  		}
  	}
  
  	return 1;
  }
  
  # Although flush_locations is only publically a Document-level method,
  # we are able to implement it at an Element level, allowing us to
  # selectively flush only the part of the document that occurs after the
  # element for which the flush is called.
  sub _flush_locations {
  	my $self  = shift;
  	unless ( $self == $self->top ) {
  		return $self->top->_flush_locations( $self );
  	}
  
  	# Get the full list of all Tokens
  	my @Tokens = $self->tokens;
  
  	# Optionally allow starting from an arbitrary element (or rather,
  	# the first Token equal-to-or-within an arbitrary element)
  	if ( _INSTANCE($_[0], 'PPI::Element') ) {
  		my $start = shift->first_token;
  		while ( my $Token = shift @Tokens ) {
  			return 1 unless $Token->{_location};
  			next unless refaddr($Token) == refaddr($start);
  
  			# Found the start. Flush it's location
  			delete $$Token->{_location};
  			last;
  		}
  	}
  
  	# Iterate over any remaining Tokens and flush their location
  	foreach my $Token ( @Tokens ) {
  		delete $Token->{_location};
  	}
  
  	1;
  }
  
  
  
  
  
  #####################################################################
  # XML Compatibility Methods
  
  sub _xml_name {
  	my $class = ref $_[0] || $_[0];
  	my $name  = lc join( '_', split /::/, $class );
  	substr($name, 4);
  }
  
  sub _xml_attr {
  	return {};
  }
  
  sub _xml_content {
  	defined $_[0]->{content} ? $_[0]->{content} : '';
  }
  
  
  
  
  
  #####################################################################
  # Internals
  
  # Set the error string
  sub _error {
  	$errstr = $_[1];
  	undef;
  }
  
  # Clear the error string
  sub _clear {
  	$errstr = '';
  	$_[0];
  }
  
  # Being DESTROYed in this manner, rather than by an explicit
  # ->delete means our reference count has probably fallen to zero.
  # Therefore we don't need to remove ourselves from our parent,
  # just the index ( just in case ).
  ### XS -> PPI/XS.xs:_PPI_Element__DESTROY 0.900+
  sub DESTROY { delete $_PARENT{refaddr $_[0]} }
  
  # Operator overloads
  sub __equals  { ref $_[1] and refaddr($_[0]) == refaddr($_[1]) }
  sub __nequals { !__equals(@_) }
  sub __eq {
  	my $self  = _INSTANCE($_[0], 'PPI::Element') ? $_[0]->content : $_[0];
  	my $other = _INSTANCE($_[1], 'PPI::Element') ? $_[1]->content : $_[1];
  	$self eq $other;
  }
  sub __ne { !__eq(@_) }
  
  1;
  
  =pod
  
  =head1 TO DO
  
  It would be nice if C<location> could be used in an ad-hoc manner. That is,
  if called on an Element within a Document that has not been indexed, it will
  do a one-off calculation to find the location. It might be very painful if
  someone started using it a lot, without remembering to index the document,
  but it would be handy for things that are only likely to use it once, such
  as error handlers.
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_ELEMENT

$fatpacked{"PPI/Exception.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_EXCEPTION';
  package PPI::Exception;
  
  use strict;
  use Params::Util qw{_INSTANCE};
  
  use vars qw{$VERSION};
  BEGIN {
  	$VERSION = '1.215';
  }
  
  
  
  
  
  #####################################################################
  # Constructor and Accessors
  
  sub new {
  	my $class = shift;
  	return bless { @_ }, $class if @_ > 1;
  	return bless { message => $_[0] }, $class if @_;
  	return bless { message => 'Unknown Exception' }, $class;
  }
  
  sub message {
  	$_[0]->{message};
  }
  
  sub callers {
  	@{ $_[0]->{callers} || [] };
  }
  
  
  
  
  
  #####################################################################
  # Main Methods
  
  sub throw {
  	my $it = shift;
  	if ( _INSTANCE($it, 'PPI::Exception') ) {
  		if ( $it->{callers} ) {
  			push @{ $it->{callers} }, [ caller(0) ];
  		} else {
  			$it->{callers} ||= [];
  		}
  	} else {
  		my $message = $_[0] || 'Unknown Exception';
  		$it = $it->new(
  			message => $message,
  			callers => [
  				[ caller(0) ],
  			],
  		);
  	}
  	die $it;
  }
  
  1;
PPI_EXCEPTION

$fatpacked{"PPI/Exception/ParserRejection.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_EXCEPTION_PARSERREJECTION';
  package PPI::Exception::ParserRejection;
  
  use strict;
  use PPI::Exception ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Exception';
  }
  
  1;
PPI_EXCEPTION_PARSERREJECTION

$fatpacked{"PPI/Exception/ParserTimeout.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_EXCEPTION_PARSERTIMEOUT';
  package PPI::Exception::ParserTimeout;
  
  use strict;
  use PPI::Exception ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Exception';
  }
  
  1;
PPI_EXCEPTION_PARSERTIMEOUT

$fatpacked{"PPI/Find.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_FIND';
  package PPI::Find;
  
  =pod
  
  =head1 NAME
  
  PPI::Find - Object version of the Element->find method
  
  =head1 SYNOPSIS
  
    # Create the Find object
    my $Find = PPI::Find->new( \&wanted );
    
    # Return all matching Elements as a list
    my @found = $Find->in( $Document );
    
    # Can we find any matching Elements
    if ( $Find->any_matches($Document) ) {
    	print "Found at least one matching Element";
    }
    
    # Use the object as an iterator
    $Find->start($Document) or die "Failed to execute search";
    while ( my $token = $Find->match ) {
    	...
    }
  
  =head1 DESCRIPTION
  
  PPI::Find is the primary PDOM searching class in the core PPI package.
  
  =head2 History
  
  It became quite obvious during the development of PPI that many of the
  modules that would be built on top of it were going to need large numbers
  of saved, storable or easily creatable search objects that could be
  reused a number of times.
  
  Although the internal ->find method provides a basic ability to search,
  it is by no means thorough. PPI::Find attempts to resolve this problem.
  
  =head2 Structure and Style
  
  PPI::Find provides a similar API to the popular L<File::Find::Rule>
  module for file searching, but without the ability to assemble queries.
  
  The implementation of a separate PPI::Find::Rule sub-class that does
  provide this ability is left as an exercise for the reader.
  
  =head2 The &wanted function
  
  At the core of each PPI::Find object is a "wanted" function that is
  passed a number of arguments and returns a value which controls the
  flow of the search.
  
  As the search executes, each Element will be passed to the wanted function
  in depth-first order.
  
  It will be provided with two arguments. The current Element to test as $_[0],
  and the top-level Element of the search as $_[1].
  
  The &wanted function is expected to return 1 (positive) if the Element
  matches the condition, 0 (false) if it does not, and undef (undefined) if
  the condition does not match, and the Find search should not descend to
  any of the current Element's children.
  
  Errors should be reported from the &wanted function via die, which will be
  caught by the Find object and returned as an error.
  
  =head1 METHODS
  
  =cut
  
  use strict;
  use Params::Util qw{_INSTANCE};
  
  use vars qw{$VERSION};
  BEGIN {
  	$VERSION = '1.215';
  }
  
  
  
  
  
  #####################################################################
  # Constructor
  
  =pod
  
  =head2 new &wanted
  
  The C<new> constructor takes a single argument of the &wanted function,
  as described above and creates a new search.
  
  Returns a new PPI::Find object, or C<undef> if not passed a CODE reference.
  
  =cut
  
  sub new {
  	my $class  = ref $_[0] ? ref shift : shift;
  	my $wanted = ref $_[0] eq 'CODE' ? shift : return undef;
  
  	# Create the object
  	my $self = bless {
  		wanted => $wanted,
  	}, $class;
  
  	$self;
  }
  
  =pod
  
  =head2 clone
  
  The C<clone> method creates another instance of the same Find object.
  
  The cloning is done safely, so if your existing Find object is in the
  middle of an iteration, the cloned Find object will not also be in the
  iteration and can be safely used independently.
  
  Returns a duplicate PPI::Find object.
  
  =cut
  
  sub clone {
  	my $self = ref $_[0] ? shift
  		: die "->clone can only be called as an object method";
  	my $class = ref $self;
  
  	# Create the object
  	my $clone = bless {
  		wanted => $self->{wanted},
  	}, $class;
  
  	$clone;
  }
  
  
  
  
  
  ####################################################################
  # Search Execution Methods
  
  =pod
  
  =head2 in $Document [, array_ref => 1 ]
  
  The C<in> method starts and completes a full run of the search.
  
  It takes as argument a single L<PPI::Element> object which will
  serve as the top of the search process.
  
  Returns a list of PPI::Element objects that match the condition
  described by the &wanted function, or the null list on error.
  
  You should check the ->errstr method for any errors if you are
  returned the null list, which may also mean simply that no Elements
  were found that matched the condition.
  
  Because of this need to explicitly check for errors, an alternative
  return value mechanism is provide. If you pass the C<array_ref => 1>
  parameter to the method, it will return the list of matched Elements
  as a reference to an ARRAY. The method will return false if no elements
  were matched, or C<undef> on error.
  
  The ->errstr method can still be used to get the error message as normal.
  
  =cut
  
  sub in {
  	my $self    = shift;
  	my $Element = shift;
  	my %params  = @_;
  	delete $self->{errstr};
   
  	# Are we already acting as an iterator
  	if ( $self->{in} ) {
  		return $self->_error('->in called while another search is in progress', %params);
  	}
  
  	# Get the root element for the search
  	unless ( _INSTANCE($Element, 'PPI::Element') ) {
  		return $self->_error('->in was not passed a PPI::Element object', %params);
  	}
  
  	# Prepare the search
  	$self->{in}      = $Element;
  	$self->{matches} = [];
  
  	# Execute the search
  	eval {
  		$self->_execute;
  	};
  	if ( $@ ) {
  		my $errstr = $@;
  		$errstr =~ s/\s+at\s+line\s+.+$//;
  		return $self->_error("Error while searching: $errstr", %params);
  	}
  
  	# Clean up and return
  	delete $self->{in};
  	if ( $params{array_ref} ) {
  		if ( @{$self->{matches}} ) {
  			return delete $self->{matches};
  		}
  		delete $self->{matches};
  		return '';
  	}
  
  	# Return as a list
  	my $matches = delete $self->{matches};
  	@$matches;
  }
  
  =pod
  
  =head2 start $Element
  
  The C<start> method lets the Find object act as an iterator. The method
  is passed the parent PPI::Element object as for the C<in> method, but does
  not accept any parameters.
  
  To simplify error handling, the entire search is done at once, with the
  results cached and provided as-requested.
  
  Returns true if the search completes, and false on error.
  
  =cut
  
  sub start {
  	my $self    = shift;
  	my $Element = shift;
  	delete $self->{errstr};
  
  	# Are we already acting as an iterator
  	if ( $self->{in} ) {
  		return $self->_error('->in called while another search is in progress');
  	}
  
  	# Get the root element for the search
  	unless ( _INSTANCE($Element, 'PPI::Element') ) {
  		return $self->_error('->in was not passed a PPI::Element object');
  	}
  
  	# Prepare the search
  	$self->{in}      = $Element;
  	$self->{matches} = [];
  
  	# Execute the search
  	eval {
  		$self->_execute;
  	};
  	if ( $@ ) {
  		my $errstr = $@;
  		$errstr =~ s/\s+at\s+line\s+.+$//;
  		$self->_error("Error while searching: $errstr");
  		return undef;
  	}
  
  	1;
  }
  
  =pod
  
  =head2 match
  
  The C<match> method returns the next matching Element in the iteration.
  
  Returns a PPI::Element object, or C<undef> if there are no remaining
  Elements to be returned.
  
  =cut
  
  sub match {
  	my $self = shift;
  	return undef unless $self->{matches};
  
  	# Fetch and return the next match
  	my $match = shift @{$self->{matches}};
  	return $match if $match;
  
  	$self->finish;
  	undef;
  }
  
  =pod
  
  =head2 finish
  
  The C<finish> method provides a mechanism to end iteration if you wish to
  stop the iteration prematurely. It resets the Find object and allows it to
  be safely reused.
  
  A Find object will be automatically finished when C<match> returns false.
  This means you should only need to call C<finnish> when you stop
  iterating early.
  
  You may safely call this method even when not iterating and it will return
  without failure.
  
  Always returns true
  
  =cut
  
  sub finish {
  	my $self = shift;
  	delete $self->{in};
  	delete $self->{matches};
  	delete $self->{errstr};
  	1;
  }
  
  
  
  
  
  #####################################################################
  # Support Methods and Error Handling
  
  sub _execute {
  	my $self   = shift;
  	my $wanted = $self->{wanted};
  	my @queue  = ( $self->{in} );
  
  	# Pull entries off the queue and hand them off to the wanted function
  	while ( my $Element = shift @queue ) {
  		my $rv = &$wanted( $Element, $self->{in} );
  
  		# Add to the matches if returns true
  		push @{$self->{matches}}, $Element if $rv;
  
  		# Continue and don't descend if it returned undef
  		# or if it doesn't have children
  		next unless defined $rv;
  		next unless $Element->isa('PPI::Node');
  
  		# Add the children to the head of the queue
  		if ( $Element->isa('PPI::Structure') ) {
  			unshift @queue, $Element->finish if $Element->finish;
  			unshift @queue, $Element->children;
  			unshift @queue, $Element->start if $Element->start;
  		} else {
  			unshift @queue, $Element->children;
  		}
  	}
  
  	1;
  }
  
  =pod
  
  =head2 errstr
  
  The C<errstr> method returns the error messages when a given PPI::Find
  object fails any action.
  
  Returns a string, or C<undef> if there is no error.
  
  =cut
  
  sub errstr {
  	shift->{errstr};
  }
  
  sub _error {
  	my $self = shift;
  	$self->{errstr} = shift;
  	my %params = @_;
  	$params{array_ref} ? undef : ();
  }
  
  1;
  
  =pod
  
  =head1 TO DO
  
  - Implement the L<PPI::Find::Rule> class
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_FIND

$fatpacked{"PPI/Lexer.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_LEXER';
  package PPI::Lexer;
  
  =pod
  
  =head1 NAME
  
  PPI::Lexer - The PPI Lexer
  
  =head1 SYNOPSIS
  
    use PPI;
    
    # Create a new Lexer
    my $Lexer = PPI::Lexer->new;
    
    # Build a PPI::Document object from a Token stream
    my $Tokenizer = PPI::Tokenizer->load('My/Module.pm');
    my $Document = $Lexer->lex_tokenizer($Tokenizer);
    
    # Build a PPI::Document object for some raw source
    my $source = "print 'Hello World!'; kill(Humans->all);";
    $Document = $Lexer->lex_source($source);
    
    # Build a PPI::Document object for a particular file name
    $Document = $Lexer->lex_file('My/Module.pm');
  
  =head1 DESCRIPTION
  
  The is the L<PPI> Lexer. In the larger scheme of things, its job is to take
  token streams, in a variety of forms, and "lex" them into nested structures.
  
  Pretty much everything in this module happens behind the scenes at this
  point. In fact, at the moment you don't really need to instantiate the lexer
  at all, the three main methods will auto-instantiate themselves a
  C<PPI::Lexer> object as needed.
  
  All methods do a one-shot "lex this and give me a L<PPI::Document> object".
  
  In fact, if you are reading this, what you B<probably> want to do is to
  just "load a document", in which case you can do this in a much more
  direct and concise manner with one of the following.
  
    use PPI;
    
    $Document = PPI::Document->load( $filename );
    $Document = PPI::Document->new( $string );
  
  See L<PPI::Document> for more details.
  
  For more unusual tasks, by all means forge onwards.
  
  =head1 METHODS
  
  =cut
  
  use strict;
  use Scalar::Util    ();
  use Params::Util    qw{_STRING _INSTANCE};
  use List::MoreUtils ();
  use PPI             ();
  use PPI::Exception  ();
  
  use vars qw{$VERSION $errstr *_PARENT %ROUND %RESOLVE};
  BEGIN {
  	$VERSION = '1.215';
  	$errstr  = '';
  
  	# Faster than having another method call just
  	# to set the structure finish token.
  	*_PARENT = *PPI::Element::_PARENT;
  
  	# Keyword -> Structure class maps
  	%ROUND = (
  		# Conditions
  		'if'     => 'PPI::Structure::Condition',
  		'elsif'  => 'PPI::Structure::Condition',
  		'unless' => 'PPI::Structure::Condition',
  		'while'  => 'PPI::Structure::Condition',
  		'until'  => 'PPI::Structure::Condition',
  
  		# For(each)
  		'for'     => 'PPI::Structure::For',
  		'foreach' => 'PPI::Structure::For',
  	);
  
  	# Opening brace to refining method
  	%RESOLVE = (
  		'(' => '_round',
  		'[' => '_square',
  		'{' => '_curly',
  	);
  
  }
  
  # Allows for experimental overriding of the tokenizer
  use vars qw{ $X_TOKENIZER };
  BEGIN {
  	$X_TOKENIZER ||= 'PPI::Tokenizer';
  }
  use constant X_TOKENIZER => $X_TOKENIZER;
  
  
  
  
  
  #####################################################################
  # Constructor
  
  =pod
  
  =head2 new
  
  The C<new> constructor creates a new C<PPI::Lexer> object. The object itself
  is merely used to hold various buffers and state data during the lexing
  process, and holds no significant data between -E<gt>lex_xxxxx calls.
  
  Returns a new C<PPI::Lexer> object
  
  =cut
  
  sub new {
  	my $class = shift->_clear;
  	bless {
  		Tokenizer => undef, # Where we store the tokenizer for a run
  		buffer    => [],    # The input token buffer
  		delayed   => [],    # The "delayed insignificant tokens" buffer
  	}, $class;
  }
  
  
  
  
  
  #####################################################################
  # Main Lexing Methods
  
  =pod
  
  =head2 lex_file $filename
  
  The C<lex_file> method takes a filename as argument. It then loads the file,
  creates a L<PPI::Tokenizer> for the content and lexes the token stream
  produced by the tokenizer. Basically, a sort of all-in-one method for
  getting a L<PPI::Document> object from a file name.
  
  Returns a L<PPI::Document> object, or C<undef> on error.
  
  =cut
  
  sub lex_file {
  	my $self = ref $_[0] ? shift : shift->new;
  	my $file = _STRING(shift);
  	unless ( defined $file ) {
  		return $self->_error("Did not pass a filename to PPI::Lexer::lex_file");
  	}
  
  	# Create the Tokenizer
  	my $Tokenizer = eval {
  		X_TOKENIZER->new($file);
  	};
  	if ( _INSTANCE($@, 'PPI::Exception') ) {
  		return $self->_error( $@->message );
  	} elsif ( $@ ) {
  		return $self->_error( $errstr );
  	}
  
  	$self->lex_tokenizer( $Tokenizer );
  }
  
  =pod
  
  =head2 lex_source $string
  
  The C<lex_source> method takes a normal scalar string as argument. It
  creates a L<PPI::Tokenizer> object for the string, and then lexes the
  resulting token stream.
  
  Returns a L<PPI::Document> object, or C<undef> on error.
  
  =cut
  
  sub lex_source {
  	my $self   = ref $_[0] ? shift : shift->new;
  	my $source = shift;
  	unless ( defined $source and not ref $source ) {
  		return $self->_error("Did not pass a string to PPI::Lexer::lex_source");
  	}
  
  	# Create the Tokenizer and hand off to the next method
  	my $Tokenizer = eval {
  		X_TOKENIZER->new(\$source);
  	};
  	if ( _INSTANCE($@, 'PPI::Exception') ) {
  		return $self->_error( $@->message );
  	} elsif ( $@ ) {
  		return $self->_error( $errstr );
  	}
  
  	$self->lex_tokenizer( $Tokenizer );
  }
  
  =pod
  
  =head2 lex_tokenizer $Tokenizer
  
  The C<lex_tokenizer> takes as argument a L<PPI::Tokenizer> object. It
  lexes the token stream from the tokenizer into a L<PPI::Document> object.
  
  Returns a L<PPI::Document> object, or C<undef> on error.
  
  =cut
  
  sub lex_tokenizer {
  	my $self      = ref $_[0] ? shift : shift->new;
  	my $Tokenizer = _INSTANCE(shift, 'PPI::Tokenizer');
  	return $self->_error(
  		"Did not pass a PPI::Tokenizer object to PPI::Lexer::lex_tokenizer"
  	) unless $Tokenizer;
  
  	# Create the empty document
  	my $Document = PPI::Document->new;
  
  	# Lex the token stream into the document
  	$self->{Tokenizer} = $Tokenizer;
  	eval {
  		$self->_lex_document($Document);
  	};
  	if ( $@ ) {
  		# If an error occurs DESTROY the partially built document.
  		undef $Document;
  		if ( _INSTANCE($@, 'PPI::Exception') ) {
  			return $self->_error( $@->message );
  		} else {
  			return $self->_error( $errstr );
  		}
  	}
  
  	return $Document;
  }
  
  
  
  
  
  #####################################################################
  # Lex Methods - Document Object
  
  =pod
  
  =begin testing _lex_document 3
  
  # Validate the creation of a null statement
  SCOPE: {
  	my $token = new_ok( 'PPI::Token::Structure' => [ ')'    ] );
  	my $brace = new_ok( 'PPI::Statement::UnmatchedBrace' => [ $token ] );
  	is( $brace->content, ')', '->content ok' );
  }
  
  =end testing
  
  =cut
  
  sub _lex_document {
  	my ($self, $Document) = @_;
  	# my $self     = shift;
  	# my $Document = _INSTANCE(shift, 'PPI::Document') or return undef;
  
  	# Start the processing loop
  	my $Token;
  	while ( ref($Token = $self->_get_token) ) {
  		# Add insignificant tokens directly beneath us
  		unless ( $Token->significant ) {
  			$self->_add_element( $Document, $Token );
  			next;
  		}
  
  		if ( $Token->content eq ';' ) {
  			# It's a semi-colon on it's own.
  			# We call this a null statement.
  			$self->_add_element(
  				$Document,
  				PPI::Statement::Null->new($Token),
  			);
  			next;
  		}
  
  		# Handle anything other than a structural element
  		unless ( ref $Token eq 'PPI::Token::Structure' ) {
  			# Determine the class for the Statement, and create it
  			my $Statement = $self->_statement($Document, $Token)->new($Token);
  
  			# Move the lexing down into the statement
  			$self->_add_delayed( $Document );
  			$self->_add_element( $Document, $Statement );
  			$self->_lex_statement( $Statement );
  
  			next;
  		}
  
  		# Is this the opening of a structure?
  		if ( $Token->__LEXER__opens ) {
  			# This should actually have a Statement instead
  			$self->_rollback( $Token );
  			my $Statement = PPI::Statement->new;
  			$self->_add_element( $Document, $Statement );
  			$self->_lex_statement( $Statement );
  			next;
  		}
  
  		# Is this the close of a structure.
  		if ( $Token->__LEXER__closes ) {
  			# Because we are at the top of the tree, this is an error.
  			# This means either a mis-parsing, or an mistake in the code.
  			# To handle this, we create a "Naked Close" statement
  			$self->_add_element( $Document,
  				PPI::Statement::UnmatchedBrace->new($Token)
  			);
  			next;
  		}
  
  		# Shouldn't be able to get here
  		PPI::Exception->throw('Lexer reached an illegal state');
  	}
  
  	# Did we leave the main loop because of a Tokenizer error?
  	unless ( defined $Token ) {
  		my $errstr = $self->{Tokenizer} ? $self->{Tokenizer}->errstr : '';
  		$errstr ||= 'Unknown Tokenizer Error';
  		PPI::Exception->throw($errstr);
  	}
  
  	# No error, it's just the end of file.
  	# Add any insignificant trailing tokens.
  	$self->_add_delayed( $Document );
  
  	# If the Tokenizer has any v6 blocks to attach, do so now.
  	# Checking once at the end is faster than adding a special
  	# case check for every statement parsed.
  	my $perl6 = $self->{Tokenizer}->{'perl6'};
  	if ( @$perl6 ) {
  		my $includes = $Document->find( 'PPI::Statement::Include::Perl6' );
  		foreach my $include ( @$includes ) {
  			unless ( @$perl6 ) {
  				PPI::Exception->throw('Failed to find a perl6 section');
  			}
  			$include->{perl6} = shift @$perl6;
  		}
  	}
  
  	return 1;
  }
  
  
  
  
  
  #####################################################################
  # Lex Methods - Statement Object
  
  use vars qw{%STATEMENT_CLASSES};
  BEGIN {
  	# Keyword -> Statement Subclass
  	%STATEMENT_CLASSES = (
  		# Things that affect the timing of execution
  		'BEGIN'     => 'PPI::Statement::Scheduled',
  		'CHECK'     => 'PPI::Statement::Scheduled',
  		'UNITCHECK' => 'PPI::Statement::Scheduled',
  		'INIT'      => 'PPI::Statement::Scheduled',
  		'END'       => 'PPI::Statement::Scheduled',
  
  		# Loading and context statement
  		'package'   => 'PPI::Statement::Package',
  		# 'use'       => 'PPI::Statement::Include',
  		'no'        => 'PPI::Statement::Include',
  		'require'   => 'PPI::Statement::Include',
  
  		# Various declarations
  		'my'        => 'PPI::Statement::Variable',
  		'local'     => 'PPI::Statement::Variable',
  		'our'       => 'PPI::Statement::Variable',
  		'state'     => 'PPI::Statement::Variable',
  		# Statements starting with 'sub' could be any one of...
  		# 'sub'     => 'PPI::Statement::Sub',
  		# 'sub'     => 'PPI::Statement::Scheduled',
  		# 'sub'     => 'PPI::Statement',
  
  		# Compound statement
  		'if'        => 'PPI::Statement::Compound',
  		'unless'    => 'PPI::Statement::Compound',
  		'for'       => 'PPI::Statement::Compound',
  		'foreach'   => 'PPI::Statement::Compound',
  		'while'     => 'PPI::Statement::Compound',
  		'until'     => 'PPI::Statement::Compound',
  
  		# Switch statement
  		'given'     => 'PPI::Statement::Given',
  		'when'      => 'PPI::Statement::When',
  		'default'   => 'PPI::Statement::When',
  
  		# Various ways of breaking out of scope
  		'redo'      => 'PPI::Statement::Break',
  		'next'      => 'PPI::Statement::Break',
  		'last'      => 'PPI::Statement::Break',
  		'return'    => 'PPI::Statement::Break',
  		'goto'      => 'PPI::Statement::Break',
  
  		# Special sections of the file
  		'__DATA__'  => 'PPI::Statement::Data',
  		'__END__'   => 'PPI::Statement::End',
  	);
  }
  
  sub _statement {
  	my ($self, $Parent, $Token) = @_;
  	# my $self   = shift;
  	# my $Parent = _INSTANCE(shift, 'PPI::Node')  or die "Bad param 1";
  	# my $Token  = _INSTANCE(shift, 'PPI::Token') or die "Bad param 2";
  
  	# Check for things like ( parent => ... )
  	if (
  		$Parent->isa('PPI::Structure::List')
  		or
  		$Parent->isa('PPI::Structure::Constructor')
  	) {
  		if ( $Token->isa('PPI::Token::Word') ) {
  			# Is the next significant token a =>
  			# Read ahead to the next significant token
  			my $Next;
  			while ( $Next = $self->_get_token ) {
  				unless ( $Next->significant ) {
  					push @{$self->{delayed}}, $Next;
  					# $self->_delay_element( $Next );
  					next;
  				}
  
  				# Got the next token
  				if (
  					$Next->isa('PPI::Token::Operator')
  					and
  					$Next->content eq '=>'
  				) {
  					# Is an ordinary expression
  					$self->_rollback( $Next );
  					return 'PPI::Statement::Expression';
  				} else {
  					last;
  				}
  			}
  
  			# Rollback and continue
  			$self->_rollback( $Next );
  		}
  	}
  
  	# Is it a token in our known classes list
  	my $class = $STATEMENT_CLASSES{$Token->content};
  
  	# Handle potential barewords for subscripts
  	if ( $Parent->isa('PPI::Structure::Subscript') ) {
  		# Fast obvious case, just an expression
  		unless ( $class and $class->isa('PPI::Statement::Expression') ) {
  			return 'PPI::Statement::Expression';
  		}
  
  		# This is something like "my" or "our" etc... more subtle.
  		# Check if the next token is a closing curly brace.
  		# This means we are something like $h{my}
  		my $Next;
  		while ( $Next = $self->_get_token ) {
  			unless ( $Next->significant ) {
  				push @{$self->{delayed}}, $Next;
  				# $self->_delay_element( $Next );
  				next;
  			}
  
  			# Found the next significant token.
  			# Is it a closing curly brace?
  			if ( $Next->content eq '}' ) {
  				$self->_rollback( $Next );
  				return 'PPI::Statement::Expression';
  			} else {
  				$self->_rollback( $Next );
  				return $class;
  			}
  		}
  
  		# End of file... this means it is something like $h{our
  		# which is probably going to be $h{our} ... I think
  		$self->_rollback( $Next );
  		return 'PPI::Statement::Expression';
  	}
  
  	# If it's a token in our list, use that class
  	return $class if $class;
  
  	# Handle the more in-depth sub detection
  	if ( $Token->content eq 'sub' ) {
  		# Read ahead to the next significant token
  		my $Next;
  		while ( $Next = $self->_get_token ) {
  			unless ( $Next->significant ) {
  				push @{$self->{delayed}}, $Next;
  				# $self->_delay_element( $Next );
  				next;
  			}
  
  			# Got the next significant token
  			my $sclass = $STATEMENT_CLASSES{$Next->content};
  			if ( $sclass and $sclass eq 'PPI::Statement::Scheduled' ) {
  				$self->_rollback( $Next );
  				return 'PPI::Statement::Scheduled';
  			}
  			if ( $Next->isa('PPI::Token::Word') ) {
  				$self->_rollback( $Next );
  				return 'PPI::Statement::Sub';
  			}
  
  			### Comment out these two, as they would return PPI::Statement anyway
  			# if ( $content eq '{' ) {
  			#	Anonymous sub at start of statement
  			#	return 'PPI::Statement';
  			# }
  			#
  			# if ( $Next->isa('PPI::Token::Prototype') ) {
  			#	Anonymous sub at start of statement
  			#	return 'PPI::Statement';
  			# }
  
  			# PPI::Statement is the safest fall-through
  			$self->_rollback( $Next );
  			return 'PPI::Statement';
  		}
  
  		# End of file... PPI::Statement::Sub is the most likely
  		$self->_rollback( $Next );
  		return 'PPI::Statement::Sub';
  	}
  
  	if ( $Token->content eq 'use' ) {
  		# Add a special case for "use v6" lines.
  		my $Next;
  		while ( $Next = $self->_get_token ) {
  			unless ( $Next->significant ) {
  				push @{$self->{delayed}}, $Next;
  				# $self->_delay_element( $Next );
  				next;
  			}
  
  			# Found the next significant token.
  			# Is it a v6 use?
  			if ( $Next->content eq 'v6' ) {
  				$self->_rollback( $Next );
  				return 'PPI::Statement::Include::Perl6';
  			} else {
  				$self->_rollback( $Next );
  				return 'PPI::Statement::Include';
  			}
  		}
  
  		# End of file... this means it is an incomplete use
  		# line, just treat it as a normal include.
  		$self->_rollback( $Next );
  		return 'PPI::Statement::Include';
  	}
  
  	# If our parent is a Condition, we are an Expression
  	if ( $Parent->isa('PPI::Structure::Condition') ) {
  		return 'PPI::Statement::Expression';
  	}
  
  	# If our parent is a List, we are also an expression
  	if ( $Parent->isa('PPI::Structure::List') ) {
  		return 'PPI::Statement::Expression';
  	}
  
  	# Switch statements use expressions, as well.
  	if (
  		$Parent->isa('PPI::Structure::Given')
  		or
  		$Parent->isa('PPI::Structure::When')
  	) {
  		return 'PPI::Statement::Expression';
  	}
  
  	if ( _INSTANCE($Token, 'PPI::Token::Label') ) {
  		return 'PPI::Statement::Compound';
  	}
  
  	# Beyond that, I have no idea for the moment.
  	# Just keep adding more conditions above this.
  	return 'PPI::Statement';
  }
  
  sub _lex_statement {
  	my ($self, $Statement) = @_;
  	# my $self      = shift;
  	# my $Statement = _INSTANCE(shift, 'PPI::Statement') or die "Bad param 1";
  
  	# Handle some special statements
  	if ( $Statement->isa('PPI::Statement::End') ) {
  		return $self->_lex_end( $Statement );
  	}
  
  	# Begin processing tokens
  	my $Token;
  	while ( ref( $Token = $self->_get_token ) ) {
  		# Delay whitespace and comment tokens
  		unless ( $Token->significant ) {
  			push @{$self->{delayed}}, $Token;
  			# $self->_delay_element( $Token );
  			next;
  		}
  
  		# Structual closes, and __DATA__ and __END__ tags implicitly
  		# end every type of statement
  		if (
  			$Token->__LEXER__closes
  			or
  			$Token->isa('PPI::Token::Separator')
  		) {
  			# Rollback and end the statement
  			return $self->_rollback( $Token );
  		}
  
  		# Normal statements never implicitly end
  		unless ( $Statement->__LEXER__normal ) {
  			# Have we hit an implicit end to the statement
  			unless ( $self->_continues( $Statement, $Token ) ) {
  				# Rollback and finish the statement
  				return $self->_rollback( $Token );
  			}
  		}
  
  		# Any normal character just gets added
  		unless ( $Token->isa('PPI::Token::Structure') ) {
  			$self->_add_element( $Statement, $Token );
  			next;
  		}
  
  		# Handle normal statement terminators
  		if ( $Token->content eq ';' ) {
  			$self->_add_element( $Statement, $Token );
  			return 1;
  		}
  
  		# Which leaves us with a new structure
  
  		# Determine the class for the structure and create it
  		my $method    = $RESOLVE{$Token->content};
  		my $Structure = $self->$method($Statement)->new($Token);
  
  		# Move the lexing down into the Structure
  		$self->_add_delayed( $Statement );
  		$self->_add_element( $Statement, $Structure );
  		$self->_lex_structure( $Structure );
  	}
  
  	# Was it an error in the tokenizer?
  	unless ( defined $Token ) {
  		PPI::Exception->throw;
  	}
  
  	# No, it's just the end of the file...
  	# Roll back any insignificant tokens, they'll get added at the Document level
  	$self->_rollback;
  }
  
  sub _lex_end {
  	my ($self, $Statement) = @_;
  	# my $self      = shift;
  	# my $Statement = _INSTANCE(shift, 'PPI::Statement::End') or die "Bad param 1";
  
  	# End of the file, EVERYTHING is ours
  	my $Token;
  	while ( $Token = $self->_get_token ) {
  		# Inlined $Statement->__add_element($Token);
  		Scalar::Util::weaken(
  			$_PARENT{Scalar::Util::refaddr $Token} = $Statement
  		);
  		push @{$Statement->{children}}, $Token;
  	}
  
  	# Was it an error in the tokenizer?
  	unless ( defined $Token ) {
  		PPI::Exception->throw;
  	}
  
  	# No, it's just the end of the file...
  	# Roll back any insignificant tokens, they get added at the Document level
  	$self->_rollback;
  }
  
  # For many statements, it can be dificult to determine the end-point.
  # This method takes a statement and the next significant token, and attempts
  # to determine if the there is a statement boundary between the two, or if
  # the statement can continue with the token.
  sub _continues {
  	my ($self, $Statement, $Token) = @_;
  	# my $self      = shift;
  	# my $Statement = _INSTANCE(shift, 'PPI::Statement') or die "Bad param 1";
  	# my $Token     = _INSTANCE(shift, 'PPI::Token')     or die "Bad param 2";
  
  	# Handle the simple block case
  	# { print 1; }
  	if (
  		$Statement->schildren == 1
  		and
  		$Statement->schild(0)->isa('PPI::Structure::Block')
  	) {
  		return '';
  	}
  
  	# Alrighty then, there are only five implied end statement types,
  	# ::Scheduled blocks, ::Sub declarations, ::Compound, ::Given, and ::When
  	# statements.
  	unless ( ref($Statement) =~ /\b(?:Scheduled|Sub|Compound|Given|When)$/ ) {
  		return 1;
  	}
  
  	# Of these five, ::Scheduled, ::Sub, ::Given, and ::When follow the same
  	# simple rule and can be handled first.
  	my @part      = $Statement->schildren;
  	my $LastChild = $part[-1];
  	unless ( $Statement->isa('PPI::Statement::Compound') ) {
  		# If the last significant element of the statement is a block,
  		# then a scheduled statement is done, no questions asked.
  		return ! $LastChild->isa('PPI::Structure::Block');
  	}
  
  	# Now we get to compound statements, which kind of suck (to lex).
  	# However, of them all, the 'if' type, which includes unless, are
  	# relatively easy to handle compared to the others.
  	my $type = $Statement->type;
  	if ( $type eq 'if' ) {
  		# This should be one of the following
  		# if (EXPR) BLOCK
  		# if (EXPR) BLOCK else BLOCK
  		# if (EXPR) BLOCK elsif (EXPR) BLOCK ... else BLOCK
  
  		# We only implicitly end on a block
  		unless ( $LastChild->isa('PPI::Structure::Block') ) {
  			# if (EXPR) ...
  			# if (EXPR) BLOCK else ...
  			# if (EXPR) BLOCK elsif (EXPR) BLOCK ...
  			return 1;
  		}
  
  		# If the token before the block is an 'else',
  		# it's over, no matter what.
  		my $NextLast = $Statement->schild(-2);
  		if (
  			$NextLast
  			and
  			$NextLast->isa('PPI::Token')
  			and
  			$NextLast->isa('PPI::Token::Word')
  			and
  			$NextLast->content eq 'else'
  		) {
  			return '';
  		}
  
  		# Otherwise, we continue for 'elsif' or 'else' only.
  		if (
  			$Token->isa('PPI::Token::Word')
  			and (
  				$Token->content eq 'else'
  				or
  				$Token->content eq 'elsif'
  			)
  		) {
  			return 1;
  		}
  
  		return '';
  	}
  
  	if ( $type eq 'label' ) {
  		# We only have the label so far, could be any of
  		# LABEL while (EXPR) BLOCK
  		# LABEL while (EXPR) BLOCK continue BLOCK
  		# LABEL for (EXPR; EXPR; EXPR) BLOCK
  		# LABEL foreach VAR (LIST) BLOCK
  		# LABEL foreach VAR (LIST) BLOCK continue BLOCK
  		# LABEL BLOCK continue BLOCK
  
  		# Handle cases with a word after the label
  		if (
  			$Token->isa('PPI::Token::Word')
  			and
  			$Token->content =~ /^(?:while|until|for|foreach)$/
  		) {
  			return 1;
  		}
  
  		# Handle labelled blocks
  		if ( $Token->isa('PPI::Token::Structure') && $Token->content eq '{' ) {
  			return 1;
  		}
  
  		return '';
  	}
  
  	# Handle the common "after round braces" case
  	if ( $LastChild->isa('PPI::Structure') and $LastChild->braces eq '()' ) {
  		# LABEL while (EXPR) ...
  		# LABEL while (EXPR) ...
  		# LABEL for (EXPR; EXPR; EXPR) ...
  		# LABEL for VAR (LIST) ...
  		# LABEL foreach VAR (LIST) ...
  		# Only a block will do
  		return $Token->isa('PPI::Token::Structure') && $Token->content eq '{';
  	}
  
  	if ( $type eq 'for' ) {
  		# LABEL for (EXPR; EXPR; EXPR) BLOCK
  		if (
  			$LastChild->isa('PPI::Token::Word')
  			and
  			$LastChild->content =~ /^for(?:each)?\z/
  		) {
  			# LABEL for ...
  			if (
  				(
  					$Token->isa('PPI::Token::Structure')
  					and
  					$Token->content eq '('
  				)
  				or
  				$Token->isa('PPI::Token::QuoteLike::Words')
  			) {
  				return 1;
  			}
  
  			if ( $LastChild->isa('PPI::Token::QuoteLike::Words') ) {
  				# LABEL for VAR QW{} ...
  				# LABEL foreach VAR QW{} ...
  				# Only a block will do
  				return $Token->isa('PPI::Token::Structure') && $Token->content eq '{';
  			}
  
  			# In this case, we can also behave like a foreach
  			$type = 'foreach';
  
  		} elsif ( $LastChild->isa('PPI::Structure::Block') ) {
  			# LABEL for (EXPR; EXPR; EXPR) BLOCK
  			# That's it, nothing can continue
  			return '';
  
  		} elsif ( $LastChild->isa('PPI::Token::QuoteLike::Words') ) {
  			# LABEL for VAR QW{} ...
  			# LABEL foreach VAR QW{} ...
  			# Only a block will do
  			return $Token->isa('PPI::Token::Structure') && $Token->content eq '{';
  		}
  	}
  
  	# Handle the common continue case
  	if ( $LastChild->isa('PPI::Token::Word') and $LastChild->content eq 'continue' ) {
  		# LABEL while (EXPR) BLOCK continue ...
  		# LABEL foreach VAR (LIST) BLOCK continue ...
  		# LABEL BLOCK continue ...
  		# Only a block will do
  		return $Token->isa('PPI::Token::Structure') && $Token->content eq '{';
  	}
  
  	# Handle the common continuable block case
  	if ( $LastChild->isa('PPI::Structure::Block') ) {
  		# LABEL while (EXPR) BLOCK
  		# LABEL while (EXPR) BLOCK ...
  		# LABEL for (EXPR; EXPR; EXPR) BLOCK
  		# LABEL foreach VAR (LIST) BLOCK
  		# LABEL foreach VAR (LIST) BLOCK ...
  		# LABEL BLOCK ...
  		# Is this the block for a continue?
  		if ( _INSTANCE($part[-2], 'PPI::Token::Word') and $part[-2]->content eq 'continue' ) {
  			# LABEL while (EXPR) BLOCK continue BLOCK
  			# LABEL foreach VAR (LIST) BLOCK continue BLOCK
  			# LABEL BLOCK continue BLOCK
  			# That's it, nothing can continue this
  			return '';
  		}
  
  		# Only a continue will do
  		return $Token->isa('PPI::Token::Word') && $Token->content eq 'continue';
  	}
  
  	if ( $type eq 'block' ) {
  		# LABEL BLOCK continue BLOCK
  		# Every possible case is covered in the common cases above
  	}
  
  	if ( $type eq 'while' ) {
  		# LABEL while (EXPR) BLOCK
  		# LABEL while (EXPR) BLOCK continue BLOCK
  		# LABEL until (EXPR) BLOCK
  		# LABEL until (EXPR) BLOCK continue BLOCK
  		# The only case not covered is the while ...
  		if (
  			$LastChild->isa('PPI::Token::Word')
  			and (
  				$LastChild->content eq 'while'
  				or
  				$LastChild->content eq 'until'
  			)
  		) {
  			# LABEL while ...
  			# LABEL until ...
  			# Only a condition structure will do
  			return $Token->isa('PPI::Token::Structure') && $Token->content eq '(';
  		}
  	}
  
  	if ( $type eq 'foreach' ) {
  		# LABEL foreach VAR (LIST) BLOCK
  		# LABEL foreach VAR (LIST) BLOCK continue BLOCK
  		# The only two cases that have not been covered already are
  		# 'foreach ...' and 'foreach VAR ...'
  
  		if ( $LastChild->isa('PPI::Token::Symbol') ) {
  			# LABEL foreach my $scalar ...
  			# Open round brace, or a quotewords
  			return 1 if $Token->isa('PPI::Token::Structure') && $Token->content eq '(';
  			return 1 if $Token->isa('PPI::Token::QuoteLike::Words');
  			return '';
  		}
  
  		if ( $LastChild->content eq 'foreach' or $LastChild->content eq 'for' ) {
  			# There are three possibilities here
  			if (
  				$Token->isa('PPI::Token::Word')
  				and (
  					($STATEMENT_CLASSES{ $Token->content } || '')
  					eq
  					'PPI::Statement::Variable'
  				)
  			) {
  				# VAR == 'my ...'
  				return 1;
  			} elsif ( $Token->content =~ /^\$/ ) {
  				# VAR == '$scalar'
  				return 1;
  			} elsif ( $Token->isa('PPI::Token::Structure') and $Token->content eq '(' ) {
  				return 1;
  			} elsif ( $Token->isa('PPI::Token::QuoteLike::Words') ) {
  				return 1;
  			} else {
  				return '';
  			}
  		}
  
  		if (
  			($STATEMENT_CLASSES{ $LastChild->content } || '')
  			eq
  			'PPI::Statement::Variable'
  		) {
  			# LABEL foreach my ...
  			# Only a scalar will do
  			return $Token->content =~ /^\$/;
  		}
  
  		# Handle the rare for my $foo qw{bar} ... case
  		if ( $LastChild->isa('PPI::Token::QuoteLike::Words') ) {
  			# LABEL for VAR QW ...
  			# LABEL foreach VAR QW ...
  			# Only a block will do
  			return $Token->isa('PPI::Token::Structure') && $Token->content eq '{';
  		}
  	}
  
  	# Something we don't know about... what could it be
  	PPI::Exception->throw("Illegal state in '$type' compound statement");
  }
  
  
  
  
  
  #####################################################################
  # Lex Methods - Structure Object
  
  # Given a parent element, and a ( token to open a structure, determine
  # the class that the structure should be.
  sub _round {
  	my ($self, $Parent) = @_;
  	# my $self   = shift;
  	# my $Parent = _INSTANCE(shift, 'PPI::Node') or die "Bad param 1";
  
  	# Get the last significant element in the parent
  	my $Element = $Parent->schild(-1);
  	if ( _INSTANCE($Element, 'PPI::Token::Word') ) {
  		# Can it be determined because it is a keyword?
  		my $rclass = $ROUND{$Element->content};
  		return $rclass if $rclass;
  	}
  
  	# If we are part of a for or foreach statement, we are a ForLoop
  	if ( $Parent->isa('PPI::Statement::Compound') ) {
  		if ( $Parent->type =~ /^for(?:each)?$/ ) {
  			return 'PPI::Structure::For';
  		}
  	} elsif ( $Parent->isa('PPI::Statement::Given') ) {
  		return 'PPI::Structure::Given';
  	} elsif ( $Parent->isa('PPI::Statement::When') ) {
  		return 'PPI::Structure::When';
  	}
  
  	# Otherwise, it must be a list
  
  	# If the previous element is -> then we mark it as a dereference
  	if ( _INSTANCE($Element, 'PPI::Token::Operator') and $Element->content eq '->' ) {
  		$Element->{_dereference} = 1;
  	}
  
  	'PPI::Structure::List'
  }
  
  # Given a parent element, and a [ token to open a structure, determine
  # the class that the structure should be.
  sub _square {
  	my ($self, $Parent) = @_;
  	# my $self   = shift;
  	# my $Parent = _INSTANCE(shift, 'PPI::Node') or die "Bad param 1";
  
  	# Get the last significant element in the parent
  	my $Element = $Parent->schild(-1);
  
  	# Is this a subscript, like $foo[1] or $foo{expr}
  	
  	if ( $Element ) {
  		if ( $Element->isa('PPI::Token::Operator') and $Element->content eq '->' ) {
  			# $foo->[]
  			$Element->{_dereference} = 1;
  			return 'PPI::Structure::Subscript';
  		}
  		if ( $Element->isa('PPI::Structure::Subscript') ) {
  			# $foo{}[]
  			return 'PPI::Structure::Subscript';
  		}
  		if ( $Element->isa('PPI::Token::Symbol') and $Element->content =~ /^(?:\$|\@)/ ) {
  			# $foo[], @foo[]
  			return 'PPI::Structure::Subscript';
  		}
  		# FIXME - More cases to catch
  	}
  
  	# Otherwise, we assume that it's an anonymous arrayref constructor
  	'PPI::Structure::Constructor';
  }
  
  use vars qw{%CURLY_CLASSES @CURLY_LOOKAHEAD_CLASSES};
  BEGIN {
  	# Keyword -> Structure class maps
  	%CURLY_CLASSES = (
  		# Blocks
  		'sub'  => 'PPI::Structure::Block',
  		'grep' => 'PPI::Structure::Block',
  		'map'  => 'PPI::Structure::Block',
  		'sort' => 'PPI::Structure::Block',
  		'do'   => 'PPI::Structure::Block',
  
  		# Hash constructors
  		'scalar' => 'PPI::Structure::Constructor',
  		'='      => 'PPI::Structure::Constructor',
  		'||='    => 'PPI::Structure::Constructor',
  		','      => 'PPI::Structure::Constructor',
  		'=>'     => 'PPI::Structure::Constructor',
  		'+'      => 'PPI::Structure::Constructor', # per perlref
  		'return' => 'PPI::Structure::Constructor', # per perlref
  		'bless'  => 'PPI::Structure::Constructor', # pragmatic --
  		            # perlfunc says first arg is a reference, and
  			    # bless {; ... } fails to compile.
  	);
  
  	@CURLY_LOOKAHEAD_CLASSES = (
  	    {},	# not used
  	    {
  		';'    => 'PPI::Structure::Block', # per perlref
  		'}'    => 'PPI::Structure::Constructor',
  	    },
  	    {
  		'=>'   => 'PPI::Structure::Constructor',
  	    },
  	);
  }
  
  =pod
  
  =begin testing _curly 26
  
  my $document = PPI::Document->new(\<<'END_PERL');
  use constant { One => 1 };
  use constant 1 { One => 1 };
  $foo->{bar};
  $foo[1]{bar};
  $foo{bar};
  sub {1};
  grep { $_ } 0 .. 2;
  map { $_ => 1 } 0 .. 2;
  sort { $b <=> $a } 0 .. 2;
  do {foo};
  $foo = { One => 1 };
  $foo ||= { One => 1 };
  1, { One => 1 };
  One => { Two => 2 };
  {foo, bar};
  {foo => bar};
  {};
  +{foo, bar};
  {; => bar};
  @foo{'bar', 'baz'};
  @{$foo}{'bar', 'baz'};
  ${$foo}{bar};
  return { foo => 'bar' };
  bless { foo => 'bar' };
  END_PERL
   
  isa_ok( $document, 'PPI::Document' );
  $document->index_locations();
  
  my @statements;
  foreach my $elem ( @{ $document->find( 'PPI::Statement' ) || [] } ) {
  	$statements[ $elem->line_number() - 1 ] ||= $elem;
  }
  
  is( scalar(@statements), 24, 'Found 24 statements' );
  
  isa_ok( $statements[0]->schild(2), 'PPI::Structure::Constructor',
  	'The curly in ' . $statements[0]);
  isa_ok( $statements[1]->schild(3), 'PPI::Structure::Constructor',
  	'The curly in ' . $statements[1]);
  isa_ok( $statements[2]->schild(2), 'PPI::Structure::Subscript',
  	'The curly in ' . $statements[2]);
  isa_ok( $statements[3]->schild(2), 'PPI::Structure::Subscript',
  	'The curly in ' . $statements[3]);
  isa_ok( $statements[4]->schild(1), 'PPI::Structure::Subscript',
  	'The curly in ' . $statements[4]);
  isa_ok( $statements[5]->schild(1), 'PPI::Structure::Block',
  	'The curly in ' . $statements[5]);
  isa_ok( $statements[6]->schild(1), 'PPI::Structure::Block',
  	'The curly in ' . $statements[6]);
  isa_ok( $statements[7]->schild(1), 'PPI::Structure::Block',
  	'The curly in ' . $statements[7]);
  isa_ok( $statements[8]->schild(1), 'PPI::Structure::Block',
  	'The curly in ' . $statements[8]);
  isa_ok( $statements[9]->schild(1), 'PPI::Structure::Block',
  	'The curly in ' . $statements[9]);
  isa_ok( $statements[10]->schild(2), 'PPI::Structure::Constructor',
  	'The curly in ' . $statements[10]);
  isa_ok( $statements[11]->schild(3), 'PPI::Structure::Constructor',
  	'The curly in ' . $statements[11]);
  isa_ok( $statements[12]->schild(2), 'PPI::Structure::Constructor',
  	'The curly in ' . $statements[12]);
  isa_ok( $statements[13]->schild(2), 'PPI::Structure::Constructor',
  	'The curly in ' . $statements[13]);
  isa_ok( $statements[14]->schild(0), 'PPI::Structure::Block',
  	'The curly in ' . $statements[14]);
  isa_ok( $statements[15]->schild(0), 'PPI::Structure::Constructor',
  	'The curly in ' . $statements[15]);
  isa_ok( $statements[16]->schild(0), 'PPI::Structure::Constructor',
  	'The curly in ' . $statements[16]);
  isa_ok( $statements[17]->schild(1), 'PPI::Structure::Constructor',
  	'The curly in ' . $statements[17]);
  isa_ok( $statements[18]->schild(0), 'PPI::Structure::Block',
  	'The curly in ' . $statements[18]);
  isa_ok( $statements[19]->schild(1), 'PPI::Structure::Subscript',
  	'The curly in ' . $statements[19]);
  isa_ok( $statements[20]->schild(2), 'PPI::Structure::Subscript',
  	'The curly in ' . $statements[20]);
  isa_ok( $statements[21]->schild(2), 'PPI::Structure::Subscript',
  	'The curly in ' . $statements[21]);
  isa_ok( $statements[22]->schild(1), 'PPI::Structure::Constructor',
  	'The curly in ' . $statements[22]);
  isa_ok( $statements[23]->schild(1), 'PPI::Structure::Constructor',
  	'The curly in ' . $statements[23]);
  
  =end testing
  
  =cut
  
  # Given a parent element, and a { token to open a structure, determine
  # the class that the structure should be.
  sub _curly {
  	my ($self, $Parent) = @_;
  	# my $self   = shift;
  	# my $Parent = _INSTANCE(shift, 'PPI::Node') or die "Bad param 1";
  
  	# Get the last significant element in the parent
  	my $Element = $Parent->schild(-1);
  	my $content = $Element ? $Element->content : '';
  
  	# Is this a subscript, like $foo[1] or $foo{expr}
  	if ( $Element ) {
  		if ( $content eq '->' and $Element->isa('PPI::Token::Operator') ) {
  			# $foo->{}
  			$Element->{_dereference} = 1;
  			return 'PPI::Structure::Subscript';
  		}
  		if ( $Element->isa('PPI::Structure::Subscript') ) {
  			# $foo[]{}
  			return 'PPI::Structure::Subscript';
  		}
  		if ( $content =~ /^(?:\$|\@)/ and $Element->isa('PPI::Token::Symbol') ) {
  			# $foo{}, @foo{}
  			return 'PPI::Structure::Subscript';
  		}
  		if ( $Element->isa('PPI::Structure::Block') ) {
  			# deference - ${$hash_ref}{foo}
  			#     or even ${burfle}{foo}
  			# hash slice - @{$hash_ref}{'foo', 'bar'}
  			if ( my $prior = $Parent->schild(-2) ) {
  				my $prior_content = $prior->content();
  				$prior->isa( 'PPI::Token::Cast' )
  					and ( $prior_content eq '@' ||
  						$prior_content eq '$' )
  					and return 'PPI::Structure::Subscript';
  			}
  		}
  		if ( $CURLY_CLASSES{$content} ) {
  			# Known type
  			return $CURLY_CLASSES{$content};
  		}
  	}
  
  	# Are we in a compound statement
  	if ( $Parent->isa('PPI::Statement::Compound') ) {
  		# We will only encounter blocks in compound statements
  		return 'PPI::Structure::Block';
  	}
  
  	# Are we the second or third argument of use
  	if ( $Parent->isa('PPI::Statement::Include') ) {
  		if ( $Parent->schildren == 2 ||
  		    $Parent->schildren == 3 &&
  			$Parent->schild(2)->isa('PPI::Token::Number')
  		) {
  			# This is something like use constant { ... };
  			return 'PPI::Structure::Constructor';
  		}
  	}
  
  	# Unless we are at the start of the statement, everything else should be a block
  	### FIXME This is possibly a bad choice, but will have to do for now.
  	return 'PPI::Structure::Block' if $Element;
  
  	# Special case: Are we the param of a core function
  	# i.e. map({ $_ => 1 } @foo)
  	if (
  		$Parent->isa('PPI::Statement')
  		and
  		_INSTANCE($Parent->parent, 'PPI::Structure::List')
  	) {
  		my $function = $Parent->parent->parent->schild(-2);
  		if ( $function and $function->content =~ /^(?:map|grep|sort)$/ ) {
  			return 'PPI::Structure::Block';
  		}
  	}
  
  	# We need to scan ahead.
  	my $Next;
  	my $position = 0;
  	my @delayed  = ();
  	while ( $Next = $self->_get_token ) {
  		unless ( $Next->significant ) {
  			push @delayed, $Next;
  			next;
  		}
  
  		# If we are off the end of the lookahead array,
  		if ( ++$position >= @CURLY_LOOKAHEAD_CLASSES ) {
  			# default to block.
  			$self->_buffer( splice(@delayed), $Next );
  			last;
  		# If the content at this position is known
  		} elsif ( my $class = $CURLY_LOOKAHEAD_CLASSES[$position]
  			{$Next->content} ) {
  			# return the associated class.
  			$self->_buffer( splice(@delayed), $Next );
  			return $class;
  		}
  
  		# Delay and continue
  		push @delayed, $Next;
  	}
  
  	# Hit the end of the document, or bailed out, go with block
  	$self->_buffer( splice(@delayed) );
  	if ( ref $Parent eq 'PPI::Statement' ) {
  		bless $Parent, 'PPI::Statement::Compound';
  	}
  	return 'PPI::Structure::Block';
  }
  
  =pod
  
  =begin testing _lex_structure 4
  
  # Validate the creation of a null statement
  SCOPE: {
  	my $token = new_ok( 'PPI::Token::Structure' => [ ';'    ] );
  	my $null  = new_ok( 'PPI::Statement::Null'  => [ $token ] );
  	is( $null->content, ';', '->content ok' );
  }
  
  # Validate the creation of an empty statement
  new_ok( 'PPI::Statement' => [ ] );
  
  =end testing
  
  =cut
  
  sub _lex_structure {
  	my ($self, $Structure) = @_;
  	# my $self      = shift;
  	# my $Structure = _INSTANCE(shift, 'PPI::Structure') or die "Bad param 1";
  
  	# Start the processing loop
  	my $Token;
  	while ( ref($Token = $self->_get_token) ) {
  		# Is this a direct type token
  		unless ( $Token->significant ) {
  			push @{$self->{delayed}}, $Token;
  			# $self->_delay_element( $Token );
  			next;
  		}
  
  		# Anything other than a Structure starts a Statement
  		unless ( $Token->isa('PPI::Token::Structure') ) {
  			# Because _statement may well delay and rollback itself,
  			# we need to add the delayed tokens early
  			$self->_add_delayed( $Structure );
  
  			# Determine the class for the Statement and create it
  			my $Statement = $self->_statement($Structure, $Token)->new($Token);
  
  			# Move the lexing down into the Statement
  			$self->_add_element( $Structure, $Statement );
  			$self->_lex_statement( $Statement );
  
  			next;
  		}
  
  		# Is this the opening of another structure directly inside us?
  		if ( $Token->__LEXER__opens ) {
  			# Rollback the Token, and recurse into the statement
  			$self->_rollback( $Token );
  			my $Statement = PPI::Statement->new;
  			$self->_add_element( $Structure, $Statement );
  			$self->_lex_statement( $Statement );
  			next;
  		}
  
  		# Is this the close of a structure ( which would be an error )
  		if ( $Token->__LEXER__closes ) {
  			# Is this OUR closing structure
  			if ( $Token->content eq $Structure->start->__LEXER__opposite ) {
  				# Add any delayed tokens, and the finishing token (the ugly way)
  				$self->_add_delayed( $Structure );
  				$Structure->{finish} = $Token;
  				Scalar::Util::weaken(
  					$_PARENT{Scalar::Util::refaddr $Token} = $Structure
  				);
  
  				# Confirm that ForLoop structures are actually so, and
  				# aren't really a list.
  				if ( $Structure->isa('PPI::Structure::For') ) {
  					if ( 2 > scalar grep {
  						$_->isa('PPI::Statement')
  					} $Structure->children ) {
  						bless($Structure, 'PPI::Structure::List');
  					}
  				}
  				return 1;
  			}
  
  			# Unmatched closing brace.
  			# Either they typed the wrong thing, or haven't put
  			# one at all. Either way it's an error we need to
  			# somehow handle gracefully. For now, we'll treat it
  			# as implicitly ending the structure. This causes the
  			# least damage across the various reasons why this
  			# might have happened.
  			return $self->_rollback( $Token );
  		}
  
  		# It's a semi-colon on it's own, just inside the block.
  		# This is a null statement.
  		$self->_add_element(
  			$Structure,
  			PPI::Statement::Null->new($Token),
  		);
  	}
  
  	# Is this an error
  	unless ( defined $Token ) {
  		PPI::Exception->throw;
  	}
  
  	# No, it's just the end of file.
  	# Add any insignificant trailing tokens.
  	$self->_add_delayed( $Structure );
  }
  
  
  
  
  
  #####################################################################
  # Support Methods
  
  # Get the next token for processing, handling buffering
  sub _get_token {
  	shift(@{$_[0]->{buffer}}) or $_[0]->{Tokenizer}->get_token;
  }
  
  # Old long version of the above
  # my $self = shift;
  #     # First from the buffer
  #     if ( @{$self->{buffer}} ) {
  #         return shift @{$self->{buffer}};
  #     }
  #
  #     # Then from the Tokenizer
  #     $self->{Tokenizer}->get_token;
  # }
  
  # Delay the addition of a insignificant elements.
  # This ended up being inlined.
  # sub _delay_element {
  #     my $self    = shift;
  #     my $Element = _INSTANCE(shift, 'PPI::Element') or die "Bad param 1";
  #     push @{ $_[0]->{delayed} }, $_[1];
  # }
  
  # Add an Element to a Node, including any delayed Elements
  sub _add_element {
  	my ($self, $Parent, $Element) = @_;
  	# my $self    = shift;
  	# my $Parent  = _INSTANCE(shift, 'PPI::Node')    or die "Bad param 1";
  	# my $Element = _INSTANCE(shift, 'PPI::Element') or die "Bad param 2";
  
  	# Handle a special case, where a statement is not fully resolved
  	if ( ref $Parent eq 'PPI::Statement' ) {
  		my $first  = $Parent->schild(0);
  		my $second = $Parent->schild(1);
  		if ( $first and $first->isa('PPI::Token::Label') and ! $second ) {
  			# It's a labelled statement
  			if ( $STATEMENT_CLASSES{$second->content} ) {
  				bless $Parent, $STATEMENT_CLASSES{$second->content};
  			}
  		}
  	}
  
  	# Add first the delayed, from the front, then the passed element
  	foreach my $el ( @{$self->{delayed}} ) {
  		Scalar::Util::weaken(
  			$_PARENT{Scalar::Util::refaddr $el} = $Parent
  		);
  		# Inlined $Parent->__add_element($el);
  	}
  	Scalar::Util::weaken(
  		$_PARENT{Scalar::Util::refaddr $Element} = $Parent
  	);
  	push @{$Parent->{children}}, @{$self->{delayed}}, $Element;
  
  	# Clear the delayed elements
  	$self->{delayed} = [];
  }
  
  # Specifically just add any delayed tokens, if any.
  sub _add_delayed {
  	my ($self, $Parent) = @_;
  	# my $self   = shift;
  	# my $Parent = _INSTANCE(shift, 'PPI::Node') or die "Bad param 1";
  
  	# Add any delayed
  	foreach my $el ( @{$self->{delayed}} ) {
  		Scalar::Util::weaken(
  			$_PARENT{Scalar::Util::refaddr $el} = $Parent
  		);
  		# Inlined $Parent->__add_element($el);
  	}
  	push @{$Parent->{children}}, @{$self->{delayed}};
  
  	# Clear the delayed elements
  	$self->{delayed} = [];
  }
  
  # Rollback the delayed tokens, plus any passed. Once all the tokens
  # have been moved back on to the buffer, the order should be.
  # <--- @{$self->{delayed}}, @_, @{$self->{buffer}} <----
  sub _rollback {
  	my $self = shift;
  
  	# First, put any passed objects back
  	if ( @_ ) {
  		unshift @{$self->{buffer}}, splice @_;
  	}
  
  	# Then, put back anything delayed
  	if ( @{$self->{delayed}} ) {
  		unshift @{$self->{buffer}}, splice @{$self->{delayed}};
  	}
  
  	1;
  }
  
  # Partial rollback, just return a single list to the buffer
  sub _buffer {
  	my $self = shift;
  
  	# Put any passed objects back
  	if ( @_ ) {
  		unshift @{$self->{buffer}}, splice @_;
  	}
  
  	1;
  }
  
  
  
  
  
  #####################################################################
  # Error Handling
  
  # Set the error message
  sub _error {
  	$errstr = $_[1];
  	undef;
  }
  
  # Clear the error message.
  # Returns the object as a convenience.
  sub _clear {
  	$errstr = '';
  	$_[0];
  }
  
  =pod
  
  =head2 errstr
  
  For any error that occurs, you can use the C<errstr>, as either
  a static or object method, to access the error message.
  
  If no error occurs for any particular action, C<errstr> will return false.
  
  =cut
  
  sub errstr {
  	$errstr;
  }
  
  
  
  
  
  #####################################################################
  # PDOM Extensions
  #
  # This is something of a future expansion... ignore it for now :)
  #
  # use PPI::Statement::Sub ();
  #
  # sub PPI::Statement::Sub::__LEXER__normal { '' }
  
  1;
  
  =pod
  
  =head1 TO DO
  
  - Add optional support for some of the more common source filters
  
  - Some additional checks for blessing things into various Statement
  and Structure subclasses.
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_LEXER

$fatpacked{"PPI/Node.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_NODE';
  package PPI::Node;
  
  =pod
  
  =head1 NAME
  
  PPI::Node - Abstract PPI Node class, an Element that can contain other Elements
  
  =head1 INHERITANCE
  
    PPI::Node
    isa PPI::Element
  
  =head1 SYNOPSIS
  
    # Create a typical node (a Document in this case)
    my $Node = PPI::Document->new;
    
    # Add an element to the node( in this case, a token )
    my $Token = PPI::Token::Word->new('my');
    $Node->add_element( $Token );
    
    # Get the elements for the Node
    my @elements = $Node->children;
    
    # Find all the barewords within a Node
    my $barewords = $Node->find( 'PPI::Token::Word' );
    
    # Find by more complex criteria
    my $my_tokens = $Node->find( sub { $_[1]->content eq 'my' } );
    
    # Remove all the whitespace
    $Node->prune( 'PPI::Token::Whitespace' );
    
    # Remove by more complex criteria
    $Node->prune( sub { $_[1]->content eq 'my' } );
  
  =head1 DESCRIPTION
  
  The C<PPI::Node> class provides an abstract base class for the Element
  classes that are able to contain other elements L<PPI::Document>,
  L<PPI::Statement>, and L<PPI::Structure>.
  
  As well as those listed below, all of the methods that apply to
  L<PPI::Element> objects also apply to C<PPI::Node> objects.
  
  =head1 METHODS
  
  =cut
  
  use strict;
  use Carp            ();
  use Scalar::Util    qw{refaddr};
  use List::MoreUtils ();
  use Params::Util    qw{_INSTANCE _CLASS _CODELIKE};
  use PPI::Element    ();
  
  use vars qw{$VERSION @ISA *_PARENT};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Element';
  	*_PARENT = *PPI::Element::_PARENT;
  }
  
  
  
  
  
  #####################################################################
  # The basic constructor
  
  sub new {
  	my $class = ref $_[0] || $_[0];
  	bless { children => [] }, $class;
  }
  
  
  
  
  
  #####################################################################
  # PDOM Methods
  
  =pod
  
  =head2 scope
  
  The C<scope> method returns true if the node represents a lexical scope
  boundary, or false if it does not.
  
  =cut
  
  ### XS -> PPI/XS.xs:_PPI_Node__scope 0.903+
  sub scope { '' }
  
  =pod
  
  =head2 add_element $Element
  
  The C<add_element> method adds a L<PPI::Element> object to the end of a
  C<PPI::Node>. Because Elements maintain links to their parent, an
  Element can only be added to a single Node.
  
  Returns true if the L<PPI::Element> was added. Returns C<undef> if the
  Element was already within another Node, or the method is not passed 
  a L<PPI::Element> object.
  
  =cut
  
  sub add_element {
  	my $self = shift;
  
  	# Check the element
  	my $Element = _INSTANCE(shift, 'PPI::Element') or return undef;
  	$_PARENT{refaddr $Element} and return undef;
  
  	# Add the argument to the elements
  	push @{$self->{children}}, $Element;
  	Scalar::Util::weaken(
  		$_PARENT{refaddr $Element} = $self
  	);
  
  	1;
  }
  
  # In a typical run profile, add_element is the number 1 resource drain.
  # This is a highly optimised unsafe version, for internal use only.
  sub __add_element {
  	Scalar::Util::weaken(
  		$_PARENT{refaddr $_[1]} = $_[0]
  	);
  	push @{$_[0]->{children}}, $_[1];
  }
  
  =pod
  
  =head2 elements
  
  The C<elements> method accesses all child elements B<structurally> within
  the C<PPI::Node> object. Note that in the base of the L<PPI::Structure>
  classes, this C<DOES> include the brace tokens at either end of the
  structure.
  
  Returns a list of zero or more L<PPI::Element> objects.
  
  Alternatively, if called in the scalar context, the C<elements> method
  returns a count of the number of elements.
  
  =cut
  
  sub elements {
  	if ( wantarray ) {
  		return @{$_[0]->{children}};
  	} else {
  		return scalar @{$_[0]->{children}};
  	}
  }
  
  =pod
  
  =head2 first_element
  
  The C<first_element> method accesses the first element structurally within
  the C<PPI::Node> object. As for the C<elements> method, this does include
  the brace tokens for L<PPI::Structure> objects.
  
  Returns a L<PPI::Element> object, or C<undef> if for some reason the
  C<PPI::Node> object does not contain any elements.
  
  =cut
  
  # Normally the first element is also the first child
  sub first_element {
  	$_[0]->{children}->[0];
  }
  
  =pod
  
  =head2 last_element
  
  The C<last_element> method accesses the last element structurally within
  the C<PPI::Node> object. As for the C<elements> method, this does include
  the brace tokens for L<PPI::Structure> objects.
  
  Returns a L<PPI::Element> object, or C<undef> if for some reason the
  C<PPI::Node> object does not contain any elements.
  
  =cut
  
  # Normally the last element is also the last child
  sub last_element {
  	$_[0]->{children}->[-1];
  }
  
  =pod
  
  =head2 children
  
  The C<children> method accesses all child elements lexically within the
  C<PPI::Node> object. Note that in the case of the L<PPI::Structure>
  classes, this does B<NOT> include the brace tokens at either end of the
  structure.
  
  Returns a list of zero of more L<PPI::Element> objects.
  
  Alternatively, if called in the scalar context, the C<children> method
  returns a count of the number of lexical children.
  
  =cut
  
  # In the default case, this is the same as for the elements method
  sub children {
  	wantarray ? @{$_[0]->{children}} : scalar @{$_[0]->{children}};
  }
  
  =pod
  
  =head2 schildren
  
  The C<schildren> method is really just a convenience, the significant-only
  variation of the normal C<children> method.
  
  In list context, returns a list of significant children. In scalar context,
  returns the number of significant children.
  
  =cut
  
  sub schildren {
  	return grep { $_->significant } @{$_[0]->{children}} if wantarray;
  	my $count = 0;
  	foreach ( @{$_[0]->{children}} ) {
  		$count++ if $_->significant;
  	}
  	return $count;
  }
  
  =pod
  
  =head2 child $index
  
  The C<child> method accesses a child L<PPI::Element> object by its
  position within the Node.
  
  Returns a L<PPI::Element> object, or C<undef> if there is no child
  element at that node.
  
  =cut
  
  sub child {
  	$_[0]->{children}->[$_[1]];
  }
  
  =pod
  
  =head2 schild $index
  
  The lexical structure of the Perl language ignores 'insignificant' items,
  such as whitespace and comments, while L<PPI> treats these items as valid
  tokens so that it can reassemble the file at any time. Because of this,
  in many situations there is a need to find an Element within a Node by
  index, only counting lexically significant Elements.
  
  The C<schild> method returns a child Element by index, ignoring
  insignificant Elements. The index of a child Element is specified in the
  same way as for a normal array, with the first Element at index 0, and
  negative indexes used to identify a "from the end" position.
  
  =cut
  
  sub schild {
  	my $self = shift;
  	my $idx  = 0 + shift;
  	my $el   = $self->{children};
  	if ( $idx < 0 ) {
  		my $cursor = 0;
  		while ( exists $el->[--$cursor] ) {
  			return $el->[$cursor] if $el->[$cursor]->significant and ++$idx >= 0;
  		}
  	} else {
  		my $cursor = -1;
  		while ( exists $el->[++$cursor] ) {
  			return $el->[$cursor] if $el->[$cursor]->significant and --$idx < 0;
  		}
  	}
  	undef;
  }
  
  =pod
  
  =head2 contains $Element
  
  The C<contains> method is used to determine if another L<PPI::Element>
  object is logically "within" a C<PPI::Node>. For the special case of the
  brace tokens at either side of a L<PPI::Structure> object, they are
  generally considered "within" a L<PPI::Structure> object, even if they are
  not actually in the elements for the L<PPI::Structure>.
  
  Returns true if the L<PPI::Element> is within us, false if not, or C<undef>
  on error.
  
  =cut
  
  sub contains {
  	my $self    = shift;
  	my $Element = _INSTANCE(shift, 'PPI::Element') or return undef;
  
  	# Iterate up the Element's parent chain until we either run out
  	# of parents, or get to ourself.
  	while ( $Element = $Element->parent ) {
  		return 1 if refaddr($self) == refaddr($Element);
  	}
  
  	'';
  }
  
  =pod
  
  =head2 find $class | \&wanted
  
  The C<find> method is used to search within a code tree for
  L<PPI::Element> objects that meet a particular condition.
  
  To specify the condition, the method can be provided with either a simple
  class name (full or shortened), or a C<CODE>/function reference.
  
    # Find all single quotes in a Document (which is a Node)
    $Document->find('PPI::Quote::Single');
    
    # The same thing with a shortened class name
    $Document->find('Quote::Single');
    
    # Anything more elaborate, we so with the sub
    $Document->find( sub {
    	# At the top level of the file...
    	$_[1]->parent == $_[0]
    	and (
    		# ...find all comments and POD
    		$_[1]->isa('PPI::Token::Pod')
    		or
    		$_[1]->isa('PPI::Token::Comment')
    	)
    } );
  
  The function will be passed two arguments, the top-level C<PPI::Node>
  you are searching in and the current L<PPI::Element> that the condition
  is testing.
  
  The anonymous function should return one of three values. Returning true
  indicates a condition match, defined-false (C<0> or C<''>) indicates
  no-match, and C<undef> indicates no-match and no-descend.
  
  In the last case, the tree walker will skip over anything below the
  C<undef>-returning element and move on to the next element at the same
  level.
  
  To halt the entire search and return C<undef> immediately, a condition
  function should throw an exception (i.e. C<die>).
  
  Note that this same wanted logic is used for all methods documented to
  have a C<\&wanted> parameter, as this one does.
  
  The C<find> method returns a reference to an array of L<PPI::Element>
  objects that match the condition, false (but defined) if no Elements match
  the condition, or C<undef> if you provide a bad condition, or an error
  occurs during the search process.
  
  In the case of a bad condition, a warning will be emitted as well.
  
  =cut
  
  sub find {
  	my $self   = shift;
  	my $wanted = $self->_wanted(shift) or return undef;
  
  	# Use a queue based search, rather than a recursive one
  	my @found = ();
  	my @queue = @{$self->{children}};
  	eval {
  		while ( @queue ) {
  			my $Element = shift @queue;
  			my $rv      = &$wanted( $self, $Element );
  			push @found, $Element if $rv;
  
  			# Support "don't descend on undef return"
  			next unless defined $rv;
  
  			# Skip if the Element doesn't have any children
  			next unless $Element->isa('PPI::Node');
  
  			# Depth-first keeps the queue size down and provides a
  			# better logical order.
  			if ( $Element->isa('PPI::Structure') ) {
  				unshift @queue, $Element->finish if $Element->finish;
  				unshift @queue, @{$Element->{children}};
  				unshift @queue, $Element->start if $Element->start;
  			} else {
  				unshift @queue, @{$Element->{children}};
  			}
  		}
  	};
  	if ( $@ ) {
  		# Caught exception thrown from the wanted function
  		return undef;
  	}
  
  	@found ? \@found : '';
  }
  
  =pod
  
  =head2 find_first $class | \&wanted
  
  If the normal C<find> method is like a grep, then C<find_first> is
  equivalent to the L<Scalar::Util> C<first> function.
  
  Given an element class or a wanted function, it will search depth-first
  through a tree until it finds something that matches the condition,
  returning the first Element that it encounters.
  
  See the C<find> method for details on the format of the search condition.
  
  Returns the first L<PPI::Element> object that matches the condition, false
  if nothing matches the condition, or C<undef> if given an invalid condition,
  or an error occurs.
  
  =cut
  
  sub find_first {
  	my $self   = shift;
  	my $wanted = $self->_wanted(shift) or return undef;
  
  	# Use the same queue-based search as for ->find
  	my @queue = @{$self->{children}};
  	my $rv    = eval {
  		# The defined() here prevents a ton of calls to PPI::Util::TRUE
  		while ( @queue ) {
  			my $Element = shift @queue;
  			my $rv      = &$wanted( $self, $Element );
  			return $Element if $rv;
  
  			# Support "don't descend on undef return"
  			next unless defined $rv;
  
  			# Skip if the Element doesn't have any children
  			next unless $Element->isa('PPI::Node');
  
  			# Depth-first keeps the queue size down and provides a
  			# better logical order.
  			if ( $Element->isa('PPI::Structure') ) {
  				unshift @queue, $Element->finish if defined($Element->finish);
  				unshift @queue, @{$Element->{children}};
  				unshift @queue, $Element->start  if defined($Element->start);
  			} else {
  				unshift @queue, @{$Element->{children}};
  			}
  		}
  	};
  	if ( $@ ) {
  		# Caught exception thrown from the wanted function
  		return undef;
  	}
  
  	$rv or '';
  }
  
  =pod
  
  =head2 find_any $class | \&wanted
  
  The C<find_any> method is a short-circuiting true/false method that behaves
  like the normal C<find> method, but returns true as soon as it finds any
  Elements that match the search condition.
  
  See the C<find> method for details on the format of the search condition.
  
  Returns true if any Elements that match the condition can be found, false if
  not, or C<undef> if given an invalid condition, or an error occurs.
  
  =cut
  
  sub find_any {
  	my $self = shift;
  	my $rv   = $self->find_first(@_);
  	$rv ? 1 : $rv; # false or undef
  }
  
  =pod
  
  =head2 remove_child $Element
  
  If passed a L<PPI::Element> object that is a direct child of the Node,
  the C<remove_element> method will remove the C<Element> intact, along
  with any of its children. As such, this method acts essentially as a
  'cut' function.
  
  If successful, returns the removed element.  Otherwise, returns C<undef>.
  
  =cut
  
  sub remove_child {
  	my $self  = shift;
  	my $child = _INSTANCE(shift, 'PPI::Element') or return undef;
  
  	# Find the position of the child
  	my $key = refaddr $child;
  	my $p   = List::MoreUtils::firstidx {
  		refaddr $_ == $key
  	} @{$self->{children}};
  	return undef unless defined $p;
  
  	# Splice it out, and remove the child's parent entry
  	splice( @{$self->{children}}, $p, 1 );
  	delete $_PARENT{refaddr $child};
  
  	$child;
  }
  
  =pod
  
  =head2 prune $class | \&wanted
  
  The C<prune> method is used to strip L<PPI::Element> objects out of a code
  tree. The argument is the same as for the C<find> method, either a class
  name, or an anonymous subroutine which returns true/false. Any Element
  that matches the class|wanted will be deleted from the code tree, along
  with any of its children.
  
  The C<prune> method returns the number of C<Element> objects that matched
  and were removed, B<non-recursively>. This might also be zero, so avoid a
  simple true/false test on the return false of the C<prune> method. It
  returns C<undef> on error, which you probably B<should> test for.
  
  =begin testing prune 2
  
  # Avoids a bug in old Perls relating to the detection of scripts
  # Known to occur in ActivePerl 5.6.1 and at least one 5.6.2 install.
  my $hashbang = reverse 'lrep/nib/rsu/!#'; 
  my $document = PPI::Document->new( \<<"END_PERL" );
  $hashbang
  
  use strict;
  
  sub one { 1 }
  sub two { 2 }
  sub three { 3 }
  
  print one;
  print "\n";
  print three;
  print "\n";
  
  exit;
  END_PERL
  
  isa_ok( $document, 'PPI::Document' );
  ok( defined($document->prune ('PPI::Statement::Sub')),
  	'Pruned multiple subs ok' );
  
  =end testing
  
  =cut
  
  sub prune {
  	my $self   = shift;
  	my $wanted = $self->_wanted(shift) or return undef;
  
  	# Use a depth-first queue search
  	my $pruned = 0;
  	my @queue  = $self->children;
  	eval {
  		while ( my $element = shift @queue ) {
  			my $rv = &$wanted( $self, $element );
  			if ( $rv ) {
  				# Delete the child
  				$element->delete or return undef;
  				$pruned++;
  				next;
  			}
  
  			# Support the undef == "don't descend"
  			next unless defined $rv;
  
  			if ( _INSTANCE($element, 'PPI::Node') ) {
  				# Depth-first keeps the queue size down
  				unshift @queue, $element->children;
  			}
  		}
  	};
  	if ( $@ ) {
  		# Caught exception thrown from the wanted function
  		return undef;		
  	}
  
  	$pruned;
  }
  
  # This method is likely to be very heavily used, to take
  # it slowly and carefuly.
  ### NOTE: Renaming this function or changing either to self will probably
  ###       break File::Find::Rule::PPI
  sub _wanted {
  	my $either = shift;
  	my $it     = defined($_[0]) ? shift : do {
  		Carp::carp('Undefined value passed as search condition') if $^W;
  		return undef;
  	};
  
  	# Has the caller provided a wanted function directly
  	return $it if _CODELIKE($it);
  	if ( ref $it ) {
  		# No other ref types are supported
  		Carp::carp('Illegal non-CODE reference passed as search condition') if $^W;
  		return undef;
  	}
  
  	# The first argument should be an Element class, possibly in shorthand
  	$it = "PPI::$it" unless substr($it, 0, 5) eq 'PPI::';
  	unless ( _CLASS($it) and $it->isa('PPI::Element') ) {
  		# We got something, but it isn't an element
  		Carp::carp("Cannot create search condition for '$it': Not a PPI::Element") if $^W;
  		return undef;
  	}
  
  	# Create the class part of the wanted function
  	my $wanted_class = "\n\treturn '' unless \$_[1]->isa('$it');";
  
  	# Have we been given a second argument to check the content
  	my $wanted_content = '';
  	if ( defined $_[0] ) {
  		my $content = shift;
  		if ( ref $content eq 'Regexp' ) {
  			$content = "$content";
  		} elsif ( ref $content ) {
  			# No other ref types are supported
  			Carp::carp("Cannot create search condition for '$it': Not a PPI::Element") if $^W;
  			return undef;
  		} else {
  			$content = quotemeta $content;
  		}
  
  		# Complete the content part of the wanted function
  		$wanted_content .= "\n\treturn '' unless defined \$_[1]->{content};";
  		$wanted_content .= "\n\treturn '' unless \$_[1]->{content} =~ /$content/;";
  	}
  
  	# Create the complete wanted function
  	my $code = "sub {"
  		. $wanted_class
  		. $wanted_content
  		. "\n\t1;"
  		. "\n}";
  
  	# Compile the wanted function
  	$code = eval $code;
  	(ref $code eq 'CODE') ? $code : undef;
  }
  
  
  
  
  
  ####################################################################
  # PPI::Element overloaded methods
  
  sub tokens {
  	map { $_->tokens } @{$_[0]->{children}};
  }
  
  ### XS -> PPI/XS.xs:_PPI_Element__content 0.900+
  sub content {
  	join '', map { $_->content } @{$_[0]->{children}};
  }
  
  # Clone as normal, but then go down and relink all the _PARENT entries
  sub clone {
  	my $self  = shift;
  	my $clone = $self->SUPER::clone;
  	$clone->__link_children;
  	$clone;
  }
  
  sub location {
  	my $self  = shift;
  	my $first = $self->{children}->[0] or return undef;
  	$first->location;
  }
  
  
  
  
  
  #####################################################################
  # Internal Methods
  
  sub DESTROY {
  	local $_;
  	if ( $_[0]->{children} ) {
  		my @queue = $_[0];
  		while ( defined($_ = shift @queue) ) {
  			unshift @queue, @{delete $_->{children}} if $_->{children};
  
  			# Remove all internal/private weird crosslinking so that
  			# the cascading DESTROY calls will get called properly.
  			%$_ = ();
  		}
  	}
  
  	# Remove us from our parent node as normal
  	delete $_PARENT{refaddr $_[0]};
  }
  
  # Find the position of a child
  sub __position {
  	my $key = refaddr $_[1];
  	List::MoreUtils::firstidx { refaddr $_ == $key } @{$_[0]->{children}};
  }
  
  # Insert one or more elements before a child
  sub __insert_before_child {
  	my $self = shift;
  	my $key  = refaddr shift;
  	my $p    = List::MoreUtils::firstidx {
  	         refaddr $_ == $key
  	         } @{$self->{children}};
  	foreach ( @_ ) {
  		Scalar::Util::weaken(
  			$_PARENT{refaddr $_} = $self
  			);
  	}
  	splice( @{$self->{children}}, $p, 0, @_ );
  	1;
  }
  
  # Insert one or more elements after a child
  sub __insert_after_child {
  	my $self = shift;
  	my $key  = refaddr shift;
  	my $p    = List::MoreUtils::firstidx {
  	         refaddr $_ == $key
  	         } @{$self->{children}};
  	foreach ( @_ ) {
  		Scalar::Util::weaken(
  			$_PARENT{refaddr $_} = $self
  			);
  	}
  	splice( @{$self->{children}}, $p + 1, 0, @_ );
  	1;
  }
  
  # Replace a child
  sub __replace_child {
  	my $self = shift;
  	my $key  = refaddr shift;
  	my $p    = List::MoreUtils::firstidx {
  	         refaddr $_ == $key
  	         } @{$self->{children}};
  	foreach ( @_ ) {
  		Scalar::Util::weaken(
  			$_PARENT{refaddr $_} = $self
  			);
  	}
  	splice( @{$self->{children}}, $p, 1, @_ );
  	1;
  }
  
  # Create PARENT links for an entire tree.
  # Used when cloning or thawing.
  sub __link_children {
  	my $self = shift;
  
  	# Relink all our children ( depth first )
  	my @queue = ( $self );
  	while ( my $Node = shift @queue ) {
  		# Link our immediate children
  		foreach my $Element ( @{$Node->{children}} ) {
  			Scalar::Util::weaken(
  				$_PARENT{refaddr($Element)} = $Node
  				);
  			unshift @queue, $Element if $Element->isa('PPI::Node');
  		}
  
  		# If it's a structure, relink the open/close braces
  		next unless $Node->isa('PPI::Structure');
  		Scalar::Util::weaken(
  			$_PARENT{refaddr($Node->start)}  = $Node
  			) if $Node->start;
  		Scalar::Util::weaken(
  			$_PARENT{refaddr($Node->finish)} = $Node
  			) if $Node->finish;
  	}
  
  	1;
  }
  
  1;
  
  =pod
  
  =head1 TO DO
  
  - Move as much as possible to L<PPI::XS>
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_NODE

$fatpacked{"PPI/Normal.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_NORMAL';
  package PPI::Normal;
  
  =pod
  
  =head1 NAME
  
  PPI::Normal - Normalize Perl Documents
  
  =head2 DESCRIPTION
  
  Perl Documents, as created by PPI, are typically filled with all sorts of
  mess such as whitespace and comments and other things that don't effect
  the actual meaning of the code.
  
  In addition, because there is more than one way to do most things, and the
  syntax of Perl itself is quite flexible, there are many ways in which the
  "same" code can look quite different.
  
  PPI::Normal attempts to resolve this by providing a variety of mechanisms
  and algorithms to "normalize" Perl Documents, and determine a sort of base
  form for them (although this base form will be a memory structure, and
  not something that can be turned back into Perl source code).
  
  The process itself is quite complex, and so for convenience and
  extensibility it has been separated into a number of layers. At a later
  point, it will be possible to write Plugin classes to insert additional
  normalization steps into the various different layers.
  
  In addition, you can choose to do the normalization only as deep as a
  particular layer, depending on aggressively you want the normalization
  process to be.
  
  =head1 METHODS
  
  =cut
  
  use strict;
  use Carp                      ();
  use List::MoreUtils           ();
  use PPI::Util                 '_Document';
  use PPI::Document::Normalized ();
  
  use vars qw{$VERSION %LAYER};
  BEGIN {
  	$VERSION = '1.215';
  
  	# Registered function store
  	%LAYER = (
  		1 => [],
  		2 => [],
  	);
  }
  
  
  
  
  
  #####################################################################
  # Configuration
  
  =pod
  
  =head2 register $function => $layer, ...
  
  The C<register> method is used by normalization method providers to
  tell the normalization engines which functions need to be run, and
  in which layer they apply.
  
  Provide a set of key/value pairs, where the key is the full name of the
  function (in string form), and the value is the layer (see description
  of the layers above) in which it should be run.
  
  Returns true if all functions are registered, or C<undef> on error.
  
  =cut
  
  sub register {
  	my $class = shift;
  	while ( @_ ) {
  		# Check the function
  		my $function = shift;
  		SCOPE: {
  			no strict 'refs';
  			defined $function and defined &{"$function"}
  				or Carp::croak("Bad function name provided to PPI::Normal");
  		}
  
  		# Has it already been added?
  		if ( List::MoreUtils::any { $_ eq $function } ) {
  			return 1;
  		}
  
  		# Check the layer to add it to
  		my $layer = shift;
  		defined $layer and $layer =~ /^(?:1|2)$/
  			or Carp::croak("Bad layer provided to PPI::Normal");
  
  		# Add to the layer data store
  		push @{ $LAYER{$layer} }, $function;
  	}
  
  	1;
  }
  
  # With the registration mechanism in place, load in the main set of
  # normalization methods to initialize the store.
  use PPI::Normal::Standard;
  
  
  
  
  
  #####################################################################
  # Constructor and Accessors
  
  =pod
  
  =head2 new
  
    my $level_1 = PPI::Normal->new;
    my $level_2 = PPI::Normal->new(2);
  
  Creates a new normalization object, to which Document objects
  can be passed to be normalized.
  
  Of course, what you probably REALLY want is just to call
  L<PPI::Document>'s C<normalize> method.
  
  Takes an optional single parameter of the normalisation layer
  to use, which at this time can be either "1" or "2".
  
  Returns a new C<PPI::Normal> object, or C<undef> on error.
  
  =begin testing new after PPI::Document 12
  
  # Check we actually set the layer at creation
  my $layer_1 = PPI::Normal->new;
  isa_ok( $layer_1, 'PPI::Normal' );
  is( $layer_1->layer, 1, '->new creates a layer 1' );
  my $layer_1a = PPI::Normal->new(1);
  isa_ok( $layer_1a, 'PPI::Normal' );
  is( $layer_1a->layer, 1, '->new(1) creates a layer 1' );
  my $layer_2 = PPI::Normal->new(2);
  isa_ok( $layer_2, 'PPI::Normal' );
  is( $layer_2->layer, 2, '->new(2) creates a layer 2' );
  
  # Test bad things
  is( PPI::Normal->new(3), undef, '->new only allows up to layer 2' );
  is( PPI::Normal->new(undef), undef, '->new(evil) returns undef' );
  is( PPI::Normal->new("foo"), undef, '->new(evil) returns undef' );
  is( PPI::Normal->new(\"foo"), undef, '->new(evil) returns undef' );
  is( PPI::Normal->new([]), undef, '->new(evil) returns undef' );
  is( PPI::Normal->new({}), undef, '->new(evil) returns undef' );
  
  =end testing
  
  =cut
  
  sub new {
  	my $class = shift;
  	my $layer = @_ ?
  		(defined $_[0] and ! ref $_[0] and $_[0] =~ /^[12]$/) ? shift : return undef
  		: 1;
  
  	# Create the object
  	my $object = bless {
  		layer => $layer,
  		}, $class;
  
  	$object;
  }
  
  =pod
  
  =head1 layer
  
  The C<layer> accessor returns the normalisation layer of the object.
  
  =cut
  
  sub layer { $_[0]->{layer} }
  
  
  
  
  
  #####################################################################
  # Main Methods
  
  =pod
  
  =head2 process
  
  The C<process> method takes anything that can be converted to a
  L<PPI::Document> (object, SCALAR ref, filename), loads it and
  applies the normalisation process to the document.
  
  Returns a L<PPI::Document::Normalized> object, or C<undef> on error.
  
  =begin testing process after new 15
  
  my $doc1 = PPI::Document->new(\'print "Hello World!\n";');
  isa_ok( $doc1, 'PPI::Document' );
  my $doc2 = \'print "Hello World!\n";';
  my $doc3 = \' print  "Hello World!\n"; # comment';
  my $doc4 = \'print "Hello World!\n"';
  
  # Normalize them at level 1
  my $layer1 = PPI::Normal->new(1);
  isa_ok( $layer1, 'PPI::Normal' );
  my $nor11 = $layer1->process($doc1->clone);
  my $nor12 = $layer1->process($doc2);
  my $nor13 = $layer1->process($doc3);
  isa_ok( $nor11, 'PPI::Document::Normalized' );
  isa_ok( $nor12, 'PPI::Document::Normalized' );
  isa_ok( $nor13, 'PPI::Document::Normalized' );
  
  # The first 3 should be the same, the second not
  is_deeply( { %$nor11 }, { %$nor12 }, 'Layer 1: 1 and 2 match' );
  is_deeply( { %$nor11 }, { %$nor13 }, 'Layer 1: 1 and 3 match' );
  
  # Normalize them at level 2
  my $layer2 = PPI::Normal->new(2);
  isa_ok( $layer2, 'PPI::Normal' );
  my $nor21 = $layer2->process($doc1);
  my $nor22 = $layer2->process($doc2);
  my $nor23 = $layer2->process($doc3); 
  my $nor24 = $layer2->process($doc4);
  isa_ok( $nor21, 'PPI::Document::Normalized' );
  isa_ok( $nor22, 'PPI::Document::Normalized' );
  isa_ok( $nor23, 'PPI::Document::Normalized' );
  isa_ok( $nor24, 'PPI::Document::Normalized' );
  
  # The first 3 should be the same, the second not
  is_deeply( { %$nor21 }, { %$nor22 }, 'Layer 2: 1 and 2 match' );
  is_deeply( { %$nor21 }, { %$nor23 }, 'Layer 2: 1 and 3 match' );
  is_deeply( { %$nor21 }, { %$nor24 }, 'Layer 2: 1 and 4 match' );
  
  =end testing
  
  =cut
  
  sub process {
  	my $self = ref $_[0] ? shift : shift->new;
  
  	# PPI::Normal objects are reusable, but not re-entrant
  	return undef if $self->{Document};
  
  	# Get or create the document
  	$self->{Document} = _Document(shift) or return undef;
  
  	# Work out what functions we need to call
  	my @functions = ();
  	foreach ( 1 .. $self->layer ) {
  		push @functions, @{ $LAYER{$_} };
  	}
  
  	# Execute each function
  	foreach my $function ( @functions ) {
  		no strict 'refs';
  		&{"$function"}( $self->{Document} );
  	}
  
  	# Create the normalized Document object
  	my $Normalized = PPI::Document::Normalized->new(
  		Document  => $self->{Document},
  		version   => $VERSION,
  		functions => \@functions,
  	) or return undef;
  
  	# Done, clean up
  	delete $self->{Document};
  	return $Normalized;
  }
  
  1;
  
  =pod
  
  =head1 NOTES
  
  The following normalisation layers are implemented. When writing
  plugins, you should register each transformation function with the
  appropriate layer.
  
  =head2 Layer 1 - Insignificant Data Removal
  
  The basic step common to all normalization, layer 1 scans through the
  Document and removes all whitespace, comments, POD, and anything else
  that returns false for its C<significant> method.
  
  It also checks each Element and removes known-useless sub-element
  metadata such as the Element's physical position in the file.
  
  =head2 Layer 2 - Significant Element Removal
  
  After the removal of the insignificant data, Layer 2 removed larger, more
  complex, and superficially "significant" elements, that can be removed
  for the purposes of normalisation.
  
  Examples from this layer include pragmas, now-useless statement
  separators (since the PDOM tree is holding statement elements), and
  several other minor bits and pieces.
  
  =head2 Layer 3 - TO BE COMPLETED
  
  This version of the forward-port of the Perl::Compare functionality
  to the 0.900+ API of PPI only implements Layer 1 and 2 at this time.
  
  =head1 TO DO
  
  - Write the other 4-5 layers :)
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2005 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_NORMAL

$fatpacked{"PPI/Normal/Standard.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_NORMAL_STANDARD';
  package PPI::Normal::Standard;
  
  =pod
  
  =head1 NAME
  
  PPI::Normal::Standard - Provides standard document normalization functions
  
  =head1 DESCRIPTION
  
  This module provides the default normalization methods for L<PPI::Normal>.
  
  There is no reason for you to need to load this yourself.
  
  B<Move along, nothing to see here>.
  
  =cut
  
  use strict;
  
  use vars qw{$VERSION};
  BEGIN {
  	$VERSION = '1.215';
  }
  
  
  
  
  
  #####################################################################
  # Configuration and Registration
  
  my @METHODS = (
  	remove_insignificant_elements => 1,
  	remove_useless_attributes     => 1,
  	remove_useless_pragma         => 2,
  	remove_statement_separator    => 2,
  	remove_useless_return         => 2,
  );
  
  sub import {
  	PPI::Normal->register(
  		map { /\D/ ? "PPI::Normal::Standard::$_" : $_ } @METHODS
  	) or die "Failed to register PPI::Normal::Standard transforms";
  }
  
  
  
  
  
  #####################################################################
  # Level 1 Transforms
  
  # Remove all insignificant elements
  sub remove_insignificant_elements {
  	my $Document = shift;
  	$Document->prune( sub { ! $_[1]->significant } );
  }
  
  # Remove custom attributes that are not relevant to normalization
  sub remove_useless_attributes {
  	my $Document = shift;
  	delete $Document->{tab_width};
  
  	### FIXME - Add support for more things
  }
  
  
  
  
  
  #####################################################################
  # Level 2 Transforms
  
  # Remove version dependencies and pragma
  my $remove_pragma = map { $_ => 1 } qw{
  	strict warnings diagnostics	less
  	};
  sub remove_useless_pragma {
  	my $Document = shift;
  	$Document->prune( sub {
  		return '' unless $_[1]->isa('PPI::Statement::Include');
  		return 1  if     $_[1]->version;
  		return 1  if     $remove_pragma->{$_[1]->pragma};
  		'';
  	} );
  }
  
  # Remove all semi-colons at the end of statements
  sub remove_statement_separator {
  	my $Document = shift;
  	$Document->prune( sub {
  		$_[1]->isa('PPI::Token::Structure') or return '';
  		$_[1]->content eq ';'               or return '';
  		my $stmt = $_[1]->parent            or return '';
  		$stmt->isa('PPI::Statement')        or return '';
  		$_[1]->next_sibling                and return '';
  		1;
  	} );
  }
  
  # In any block, the "return" in the last statement is not
  # needed if there is only one and only one thing after the
  # return.
  sub remove_useless_return {
  	my $Document = shift;
  	$Document->prune( sub {
  		$_[1]->isa('PPI::Token::Word')       or return '';
  		$_[1]->content eq 'return'           or return '';
  		my $stmt = $_[1]->parent             or return '';
  		$stmt->isa('PPI::Statement::Break')  or return '';
  		$stmt->children == 2                 or return '';
  		$stmt->next_sibling                 and return '';
  		my $block = $stmt->parent            or return '';
  		$block->isa('PPI::Structure::Block') or return '';
  		1;
  	} );
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2005 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_NORMAL_STANDARD

$fatpacked{"PPI/Statement.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_STATEMENT';
  package PPI::Statement;
  
  =pod
  
  =head1 NAME
  
  PPI::Statement - The base class for Perl statements
  
  =head1 INHERITANCE
  
    PPI::Statement
    isa PPI::Node
        isa PPI::Element
  
  =head1 DESCRIPTION
  
  PPI::Statement is the root class for all Perl statements. This includes (from
  L<perlsyn>) "Declarations", "Simple Statements" and "Compound Statements".
  
  The class PPI::Statement itself represents a "Simple Statement" as defined
  in the L<perlsyn> manpage.
  
  =head1 STATEMENT CLASSES
  
  Please note that unless documented themselves, these classes are yet to be
  frozen/finalised. Names may change slightly or be added or removed.
  
  =head2 L<PPI::Statement::Scheduled>
  
  This covers all "scheduled" blocks, chunks of code that are executed separately
  from the main body of the code, at a particular time. This includes all
  C<BEGIN>, C<CHECK>, C<UNITCHECK>, C<INIT> and C<END> blocks.
  
  =head2 L<PPI::Statement::Package>
  
  A package declaration, as defined in L<perlfunc|perlfunc/package>.
  
  =head2 L<PPI::Statement::Include>
  
  A statement that loads or unloads another module.
  
  This includes 'use', 'no', and 'require' statements.
  
  =head2 L<PPI::Statement::Sub>
  
  A named subroutine declaration, or forward declaration
  
  =head2 L<PPI::Statement::Variable>
  
  A variable declaration statement. This could be either a straight
  declaration or also be an expression.
  
  This includes all 'my', 'state', 'local' and 'our' statements.
  
  =head2 L<PPI::Statement::Compound>
  
  This covers the whole family of 'compound' statements, as described in
  L<perlsyn|perlsyn>.
  
  This includes all statements starting with 'if', 'unless', 'for', 'foreach'
  and 'while'. Note that this does NOT include 'do', as it is treated
  differently.
  
  All compound statements have implicit ends. That is, they do not end with
  a ';' statement terminator.
  
  =head2 L<PPI::Statement::Break>
  
  A statement that breaks out of a structure.
  
  This includes all of 'redo', 'next', 'last' and 'return' statements.
  
  =head2 L<PPI::Statement::Given>
  
  The kind of statement introduced in Perl 5.10 that starts with 'given'.  This
  has an implicit end.
  
  =head2 L<PPI::Statement::When>
  
  The kind of statement introduced in Perl 5.10 that starts with 'when' or
  'default'.  This also has an implicit end.
  
  =head2 L<PPI::Statement::Data>
  
  A special statement which encompasses an entire C<__DATA__> block, including
  the initial C<'__DATA__'> token itself and the entire contents.
  
  =head2 L<PPI::Statement::End>
  
  A special statement which encompasses an entire __END__ block, including
  the initial '__END__' token itself and the entire contents, including any
  parsed PPI::Token::POD that may occur in it.
  
  =head2 L<PPI::Statement::Expression>
  
  L<PPI::Statement::Expression> is a little more speculative, and is intended
  to help represent the special rules relating to "expressions" such as in:
  
    # Several examples of expression statements
    
    # Boolean conditions
    if ( expression ) { ... }
    
    # Lists, such as for arguments
    Foo->bar( expression )
  
  =head2 L<PPI::Statement::Null>
  
  A null statement is a special case for where we encounter two consecutive
  statement terminators. ( ;; )
  
  The second terminator is given an entire statement of its own, but one
  that serves no purpose. Hence a 'null' statement.
  
  Theoretically, assuming a correct parsing of a perl file, all null statements
  are superfluous and should be able to be removed without damage to the file.
  
  But don't do that, in case PPI has parsed something wrong.
  
  =head2 L<PPI::Statement::UnmatchedBrace>
  
  Because L<PPI> is intended for use when parsing incorrect or incomplete code,
  the problem arises of what to do with a stray closing brace.
  
  Rather than die, it is allocated its own "unmatched brace" statement,
  which really means "unmatched closing brace". An unmatched open brace at the
  end of a file would become a structure with no contents and no closing brace.
  
  If the document loaded is intended to be correct and valid, finding a
  L<PPI::Statement::UnmatchedBrace> in the PDOM is generally indicative of a
  misparse.
  
  =head2 L<PPI::Statement::Unknown>
  
  This is used temporarily mid-parsing to hold statements for which the lexer
  cannot yet determine what class it should be, usually because there are
  insufficient clues, or it might be more than one thing.
  
  You should never encounter these in a fully parsed PDOM tree.
  
  =head1 METHODS
  
  C<PPI::Statement> itself has very few methods. Most of the time, you will be
  working with the more generic L<PPI::Element> or L<PPI::Node> methods, or one
  of the methods that are subclass-specific.
  
  =cut
  
  use strict;
  use Scalar::Util   ();
  use Params::Util   qw{_INSTANCE};
  use PPI::Node      ();
  use PPI::Exception ();
  
  use vars qw{$VERSION @ISA *_PARENT};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Node';
  	*_PARENT = *PPI::Element::_PARENT;
  }
  
  use PPI::Statement::Break          ();
  use PPI::Statement::Compound       ();
  use PPI::Statement::Data           ();
  use PPI::Statement::End            ();
  use PPI::Statement::Expression     ();
  use PPI::Statement::Include        ();
  use PPI::Statement::Null           ();
  use PPI::Statement::Package        ();
  use PPI::Statement::Scheduled      ();
  use PPI::Statement::Sub            ();
  use PPI::Statement::Given         ();
  use PPI::Statement::UnmatchedBrace ();
  use PPI::Statement::Unknown        ();
  use PPI::Statement::Variable       ();
  use PPI::Statement::When           ();
  
  # "Normal" statements end at a statement terminator ;
  # Some are not, and need the more rigorous _continues to see
  # if we are at an implicit statement boundary.
  sub __LEXER__normal { 1 }
  
  
  
  
  
  #####################################################################
  # Constructor
  
  sub new {
  	my $class = shift;
  	if ( ref $class ) {
  		PPI::Exception->throw;
  	}
  
  	# Create the object
  	my $self = bless { 
  		children => [],
  	}, $class;
  
  	# If we have been passed what should be an initial token, add it
  	my $token = shift;
  	if ( _INSTANCE($token, 'PPI::Token') ) {
  		# Inlined $self->__add_element(shift);
  		Scalar::Util::weaken(
  			$_PARENT{Scalar::Util::refaddr $token} = $self
  		);
  		push @{$self->{children}}, $token;
  	}
  
  	$self;
  }
  
  =pod
  
  =head2 label
  
  One factor common to most statements is their ability to be labeled.
  
  The C<label> method returns the label for a statement, if one has been
  defined, but without the trailing colon. Take the following example
  
    MYLABEL: while ( 1 .. 10 ) { last MYLABEL if $_ > 5 }
  
  For the above statement, the C<label> method would return 'MYLABEL'.
  
  Returns false if the statement does not have a label.
  
  =cut
  
  sub label {
  	my $first = shift->schild(1) or return '';
  	$first->isa('PPI::Token::Label')
  		? substr($first, 0, length($first) - 1)
  		: '';
  }
  
  =pod
  
  =head2 specialized
  
  Answer whether this is a plain statement or one that has more
  significance.
  
  Returns true if the statement is a subclass of this one, false
  otherwise.
  
  =begin testing specialized 22
  
  my $Document = PPI::Document->new(\<<'END_PERL');
  package Foo;
  use strict;
  ;
  while (1) { last; }
  BEGIN { }
  sub foo { }
  state $x;
  $x = 5;
  END_PERL
  
  isa_ok( $Document, 'PPI::Document' );
  
  my $statements = $Document->find('Statement');
  is( scalar @{$statements}, 10, 'Found the 10 test statements' );
  
  isa_ok( $statements->[0], 'PPI::Statement::Package',    'Statement 1: isa Package'            );
  ok( $statements->[0]->specialized,                      'Statement 1: is specialized'         );
  isa_ok( $statements->[1], 'PPI::Statement::Include',    'Statement 2: isa Include'            );
  ok( $statements->[1]->specialized,                      'Statement 2: is specialized'         );
  isa_ok( $statements->[2], 'PPI::Statement::Null',       'Statement 3: isa Null'               );
  ok( $statements->[2]->specialized,                      'Statement 3: is specialized'         );
  isa_ok( $statements->[3], 'PPI::Statement::Compound',   'Statement 4: isa Compound'           );
  ok( $statements->[3]->specialized,                      'Statement 4: is specialized'         );
  isa_ok( $statements->[4], 'PPI::Statement::Expression', 'Statement 5: isa Expression'         );
  ok( $statements->[4]->specialized,                      'Statement 5: is specialized'         );
  isa_ok( $statements->[5], 'PPI::Statement::Break',      'Statement 6: isa Break'              );
  ok( $statements->[5]->specialized,                      'Statement 6: is specialized'         );
  isa_ok( $statements->[6], 'PPI::Statement::Scheduled',  'Statement 7: isa Scheduled'          );
  ok( $statements->[6]->specialized,                      'Statement 7: is specialized'         );
  isa_ok( $statements->[7], 'PPI::Statement::Sub',        'Statement 8: isa Sub'                );
  ok( $statements->[7]->specialized,                      'Statement 8: is specialized'         );
  isa_ok( $statements->[8], 'PPI::Statement::Variable',   'Statement 9: isa Variable'           );
  ok( $statements->[8]->specialized,                      'Statement 9: is specialized'         );
  is( ref $statements->[9], 'PPI::Statement',             'Statement 10: is a simple Statement' );
  ok( ! $statements->[9]->specialized,                    'Statement 10: is not specialized'    );
  
  =end testing
  
  =cut
  
  # Yes, this is doing precisely what it's intending to prevent
  # client code from doing.  However, since it's here, if the
  # implementation changes, code outside PPI doesn't care.
  sub specialized {
  	__PACKAGE__ ne ref $_[0];
  }
  
  =pod
  
  =head2 stable
  
  Much like the L<PPI::Document> method of the same name, the ->stable
  method converts a statement to source and back again, to determine if
  a modified statement is still legal, and won't be interpreted in a
  different way.
  
  Returns true if the statement is stable, false if not, or C<undef> on
  error.
  
  =cut
  
  sub stable {
  	die "The ->stable method has not yet been implemented";	
  }
  
  
  
  
  
  #####################################################################
  # PPI::Element Methods
  
  # Is the statement complete.
  # By default for a statement, we need a semi-colon at the end.
  sub _complete {
  	my $self = shift;
  	my $semi = $self->schild(-1);
  	return !! (
  		defined $semi
  		and
  		$semi->isa('PPI::Token::Structure')
  		and
  		$semi->content eq ';'
  	);
  }
  
  # You can insert either a statement or a non-significant token.
  sub insert_before {
  	my $self    = shift;
  	my $Element = _INSTANCE(shift, 'PPI::Element') or return undef;
  	if ( $Element->isa('PPI::Statement') ) {
  		return $self->__insert_before($Element);
  	} elsif ( $Element->isa('PPI::Token') and ! $Element->significant ) {
  		return $self->__insert_before($Element);
  	}
  	'';
  }
  
  # As above, you can insert a statement, or a non-significant token
  sub insert_after {
  	my $self    = shift;
  	my $Element = _INSTANCE(shift, 'PPI::Element') or return undef;
  	if ( $Element->isa('PPI::Statement') ) {
  		return $self->__insert_after($Element);
  	} elsif ( $Element->isa('PPI::Token') and ! $Element->significant ) {
  		return $self->__insert_after($Element);
  	}
  	'';
  }
  
  1;
  
  =pod
  
  =head1 TO DO
  
  - Complete, freeze and document the remaining classes
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_STATEMENT

$fatpacked{"PPI/Statement/Break.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_STATEMENT_BREAK';
  package PPI::Statement::Break;
  
  =pod
  
  =head1 NAME
  
  PPI::Statement::Break - Statements which break out of normal statement flow
  
  =head1 SYNOPSIS
  
    last;
    goto FOO;
    next if condition();
    return $foo;
    redo;
  
  =head1 INHERITANCE
  
    PPI::Statement::Break
    isa PPI::Statement
        isa PPI::Node
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  C<PPI::Statement::Break> is intended to represent statements that break
  out of the normal statement flow control. This covers the basic
  types C<'redo'>, C<'goto'>, C<'next'>, C<'last'> and C<'return'>.
  
  =head1 METHODS
  
  C<PPI::Statement::Break> has no additional methods beyond the default ones
  provided by L<PPI::Statement>, L<PPI::Node> and L<PPI::Element>.
  
  However, it is expected to gain methods for identifying the line to break
  to, or the structure to break out of.
  
  =cut
  
  use strict;
  use PPI::Statement ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Statement';
  }
  
  1;
  
  =pod
  
  =head1 TO DO
  
  - Add the methods to identify the break target
  
  - Add some proper unit testing
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_STATEMENT_BREAK

$fatpacked{"PPI/Statement/Compound.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_STATEMENT_COMPOUND';
  package PPI::Statement::Compound;
  
  =pod
  
  =head1 NAME
  
  PPI::Statement::Compound - Describes all compound statements
  
  =head1 SYNOPSIS
  
    # A compound if statement
    if ( foo ) {
        bar();
    } else {
        baz();
    }
  
    # A compound loop statement
    foreach ( @list ) {
        bar($_);
    }
  
  =head1 INHERITANCE
  
    PPI::Statement::Compound
    isa PPI::Statement
        isa PPI::Node
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  C<PPI::Statement::Compound> objects are used to describe all current forms
  of compound statements, as described in L<perlsyn>.
  
  This covers blocks using C<if>, C<unless>, C<for>, C<foreach>, C<while>,
  and C<continue>. Please note this does B<not> cover "simple" statements
  with trailing conditions. Please note also that "do" is also not part of
  a compound statement.
  
    # This is NOT a compound statement
    my $foo = 1 if $condition;
  
    # This is also not a compound statement
    do { ... } until $condition;
  
  =head1 METHODS
  
  C<PPI::Statement::Compound> has a number of methods in addition to the
  standard L<PPI::Statement>, L<PPI::Node> and L<PPI::Element> methods.
  
  =cut
  
  use strict;
  use PPI::Statement ();
  
  use vars qw{$VERSION @ISA %TYPES};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Statement';
  
  	# Keyword type map
  	%TYPES = (
  		'if'      => 'if',
  		'unless'  => 'if',
  		'while'   => 'while',
  		'until'   => 'while',
  		'for'     => 'for',
  		'foreach' => 'foreach',
  	);
  }
  
  # Lexer clues
  sub __LEXER__normal { '' }
  
  
  
  
  
  #####################################################################
  # PPI::Statement::Compound analysis methods
  
  =pod
  
  =head2 type
  
  The C<type> method returns the syntactic type of the compound statement.
  
  There are four basic compound statement types.
  
  The C<'if'> type includes all variations of the if and unless statements,
  including any C<'elsif'> or C<'else'> parts of the compound statement.
  
  The C<'while'> type describes the standard while and until statements, but
  again does B<not> describes simple statements with a trailing while.
  
  The C<'for'> type covers the C-style for loops, regardless of whether they
  were declared using C<'for'> or C<'foreach'>.
  
  The C<'foreach'> type covers loops that iterate over collections,
  regardless of whether they were declared using C<'for'> or C<'foreach'>.
  
  All of the compounds are a variation on one of these four.
  
  Returns the simple string C<'if'>, C<'for'>, C<'foreach'> or C<'while'>,
  or C<undef> if the type cannot be determined.
  
  =begin testing type 52
  
  my $Document = PPI::Document->new(\<<'END_PERL');
         while (1) { }
         until (1) { }
  LABEL: while (1) { }
  LABEL: until (1) { }
  
  if (1) { }
  unless (1) { }
  
         for              (@foo) { }
         foreach          (@foo) { }
         for     $x       (@foo) { }
         foreach $x       (@foo) { }
         for     my $x    (@foo) { }
         foreach my $x    (@foo) { }
         for     state $x (@foo) { }
         foreach state $x (@foo) { }
  LABEL: for              (@foo) { }
  LABEL: foreach          (@foo) { }
  LABEL: for     $x       (@foo) { }
  LABEL: foreach $x       (@foo) { }
  LABEL: for     my $x    (@foo) { }
  LABEL: foreach my $x    (@foo) { }
  LABEL: for     state $x (@foo) { }
  LABEL: foreach state $x (@foo) { }
  
         for              qw{foo} { }
         foreach          qw{foo} { }
         for     $x       qw{foo} { }
         foreach $x       qw{foo} { }
         for     my $x    qw{foo} { }
         foreach my $x    qw{foo} { }
         for     state $x qw{foo} { }
         foreach state $x qw{foo} { }
  LABEL: for              qw{foo} { }
  LABEL: foreach          qw{foo} { }
  LABEL: for     $x       qw{foo} { }
  LABEL: foreach $x       qw{foo} { }
  LABEL: for     my $x    qw{foo} { }
  LABEL: foreach my $x    qw{foo} { }
  LABEL: for     state $x qw{foo} { }
  LABEL: foreach state $x qw{foo} { }
  
         for     (             ;       ;     ) { }
         foreach (             ;       ;     ) { }
         for     ($x = 0       ; $x < 1; $x++) { }
         foreach ($x = 0       ; $x < 1; $x++) { }
         for     (my $x = 0    ; $x < 1; $x++) { }
         foreach (my $x = 0    ; $x < 1; $x++) { }
  LABEL: for     (             ;       ;     ) { }
  LABEL: foreach (             ;       ;     ) { }
  LABEL: for     ($x = 0       ; $x < 1; $x++) { }
  LABEL: foreach ($x = 0       ; $x < 1; $x++) { }
  LABEL: for     (my $x = 0    ; $x < 1; $x++) { }
  LABEL: foreach (my $x = 0    ; $x < 1; $x++) { }
  END_PERL
  isa_ok( $Document, 'PPI::Document' );
  
  my $statements = $Document->find('Statement::Compound');
  is( scalar @{$statements}, 50, 'Found the 50 test statements' );
  
  is( $statements->[0]->type, 'while', q<Type of while is "while"> );
  is( $statements->[1]->type, 'while', q<Type of until is "while"> );
  is( $statements->[2]->type, 'while', q<Type of while with label is "while"> );
  is( $statements->[3]->type, 'while', q<Type of until with label is "while"> );
  is( $statements->[4]->type, 'if',    q<Type of if is "if"> );
  is( $statements->[5]->type, 'if',    q<Type of unless is "if"> );
  
  foreach my $index (6..37) {
  	my $statement = $statements->[$index];
  	is( $statement->type, 'foreach', qq<Type is "foreach": $statement> );
  }
  
  foreach my $index (38..49) {
  	my $statement = $statements->[$index];
  	is( $statement->type, 'for', qq<Type is "for": $statement> );
  }
  
  =end testing
  
  =cut
  
  sub type {
  	my $self    = shift;
  	my $p       = 0; # Child position
  	my $Element = $self->schild($p) or return undef;
  
  	# A labelled statement
  	if ( $Element->isa('PPI::Token::Label') ) {
  		$Element = $self->schild(++$p) or return 'label';
  	}
  
  	# Most simple cases
  	my $content = $Element->content;
  	if ( $content =~ /^for(?:each)?\z/ ) {
  		$Element = $self->schild(++$p) or return $content;
  		if ( $Element->isa('PPI::Token') ) {
  			return 'foreach' if $Element->content =~ /^my|our|state\z/;
  			return 'foreach' if $Element->isa('PPI::Token::Symbol');
  			return 'foreach' if $Element->isa('PPI::Token::QuoteLike::Words');
  		}
  		if ( $Element->isa('PPI::Structure::List') ) {
  			return 'foreach';
  		}
  		return 'for';
  	}
  	return $TYPES{$content} if $Element->isa('PPI::Token::Word');
  	return 'continue'       if $Element->isa('PPI::Structure::Block');
  
  	# Unknown (shouldn't exist?)
  	undef;
  }
  
  
  
  
  
  #####################################################################
  # PPI::Node Methods
  
  sub scope { 1 }
  
  
  
  
  
  #####################################################################
  # PPI::Element Methods
  
  sub _complete {
  	my $self = shift;
  	my $type = $self->type or die "Illegal compound statement type";
  
  	# Check the different types of compound statements
  	if ( $type eq 'if' ) {
  		# Unless the last significant child is a complete
  		# block, it must be incomplete.
  		my $child = $self->schild(-1) or return '';
  		$child->isa('PPI::Structure') or return '';
  		$child->braces eq '{}'        or return '';
  		$child->_complete             or return '';
  
  		# It can STILL be
  	} elsif ( $type eq 'while' ) {
  		die "CODE INCOMPLETE";
  	} else {
  		die "CODE INCOMPLETE";
  	}
  }
  
  1;
  
  =pod
  
  =head1 TO DO
  
  - Write unit tests for this package
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_STATEMENT_COMPOUND

$fatpacked{"PPI/Statement/Data.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_STATEMENT_DATA';
  package PPI::Statement::Data;
  
  =pod
  
  =head1 NAME
  
  PPI::Statement::Data - The __DATA__ section of a file
  
  =head1 SYNOPSIS
  
    # Normal content
    
    __DATA__
    This: data
    is: part
    of: the
    PPI::Statement::Data: object
  
  =head1 INHERITANCE
  
    PPI::Statement::Compound
    isa PPI::Statement
        isa PPI::Node
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  C<PPI::Statement::Data> is a utility class designed to hold content in
  the __DATA__ section of a file. It provides a single statement to hold
  B<all> of the data.
  
  =head1 METHODS
  
  C<PPI::Statement::Data> has no additional methods beyond the default ones
  provided by L<PPI::Statement>, L<PPI::Node> and L<PPI::Element>.
  
  However, it is expected to gain methods for accessing the data directly,
  (as a filehandle for example) just as you would access the data in the
  Perl code itself.
  
  =cut
  
  use strict;
  use PPI::Statement ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Statement';
  }
  
  # Data is never complete
  sub _complete () { '' }
  
  1;
  
  =pod
  
  =head1 TO DO
  
  - Add the methods to read in the data
  
  - Add some proper unit testing
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_STATEMENT_DATA

$fatpacked{"PPI/Statement/End.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_STATEMENT_END';
  package PPI::Statement::End;
  
  =pod
  
  =head1 NAME
  
  PPI::Statement::End - Content after the __END__ of a module
  
  =head1 SYNOPSIS
  
    # This is normal content
    
    __END__
    
    This is part of an PPI::Statement::End statement
    
    =pod
    
    This is not part of the ::End statement, it's POD
    
    =cut
    
    This is another PPI::Statement::End statement
  
  =head1 INHERITANCE
  
    PPI::Statement::End
    isa PPI::Statement
        isa PPI::Node
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  C<PPI::Statement::End> is a utility class designed to serve as a contained
  for all of the content after the __END__ tag in a file.
  
  It doesn't cover the ENTIRE of the __END__ section, and can be interspersed
  with L<PPI::Token::Pod> tokens.
  
  =head1 METHODS
  
  C<PPI::Statement::End> has no additional methods beyond the default ones
  provided by L<PPI::Statement>, L<PPI::Node> and L<PPI::Element>.
  
  =cut
  
  use strict;
  use PPI::Statement ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Statement';
  }
  
  # Once we have an __END__ we're done
  sub _complete () { 1 }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_STATEMENT_END

$fatpacked{"PPI/Statement/Expression.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_STATEMENT_EXPRESSION';
  package PPI::Statement::Expression;
  
  =pod
  
  =head1 NAME
  
  PPI::Statement::Expression - A generic and non-specialised statement
  
  =head1 SYNOPSIS
  
    $foo = bar;
    ("Hello World!");
    do_this();
  
  =head1 INHERITANCE
  
    PPI::Statement::Expression
    isa PPI::Statement
        isa PPI::Node
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  A C<PPI::Statement::Expression> is a normal statement that is evaluated,
  may or may not assign, may or may not have side effects, and has no special
  or redeeming features whatsoever.
  
  It provides a default for all statements that don't fit into any other
  classes.
  
  =head1 METHODS
  
  C<PPI::Statement::Expression> has no additional methods beyond the default ones
  provided by L<PPI::Statement>, L<PPI::Node> and L<PPI::Element>.
  
  =cut
  
  use strict;
  use PPI::Statement ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Statement';
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_STATEMENT_EXPRESSION

$fatpacked{"PPI/Statement/Given.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_STATEMENT_GIVEN';
  package PPI::Statement::Given;
  
  =pod
  
  =head1 NAME
  
  PPI::Statement::Given - Describes all compound statements
  
  =head1 SYNOPSIS
  
    given ( foo ) {
        say $_;
    }
  
  =head1 INHERITANCE
  
    PPI::Statement::Given
    isa PPI::Statement
        isa PPI::Node
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  C<PPI::Statement::Given> objects are used to describe switch statements, as
  described in L<perlsyn>.
  
  =head1 METHODS
  
  C<PPI::Statement::Given> has no methods beyond those provided by the
  standard L<PPI::Structure>, L<PPI::Node> and L<PPI::Element> methods.
  
  Got any ideas for methods? Submit a report to rt.cpan.org!
  
  =cut
  
  use strict;
  use PPI::Statement ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Statement';
  }
  
  # Lexer clues
  sub __LEXER__normal { '' }
  
  sub _complete {
  	my $child = $_[0]->schild(-1);
  	return !! (
  		defined $child
  		and
  		$child->isa('PPI::Structure::Block')
  		and
  		$child->complete
  	);
  }
  
  
  
  
  
  #####################################################################
  # PPI::Node Methods
  
  sub scope () { 1 }
  
  1;
  
  =pod
  
  =head1 TO DO
  
  - Write unit tests for this package
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_STATEMENT_GIVEN

$fatpacked{"PPI/Statement/Include.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_STATEMENT_INCLUDE';
  package PPI::Statement::Include;
  
  =pod
  
  =head1 NAME
  
  PPI::Statement::Include - Statements that include other code
  
  =head1 SYNOPSIS
  
    # The following are all includes
    use 5.006;
    use strict;
    use My::Module;
    use constant FOO => 'Foo';
    require Foo::Bar;
    require "Foo/Bar.pm";
    require $foo if 1;
    no strict 'refs';
  
  =head1 INHERITANCE
  
    PPI::Statement::Include
    isa PPI::Statement
        isa PPI::Node
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  Despite its name, the C<PPI::Statement::Include> class covers a number
  of different types of statement that cover all statements starting with
  C<use>, C<no> and C<require>.
  
  But basically, they cover three situations.
  
  Firstly, a dependency on a particular version of perl (for which the
  C<version> method returns true), a pragma (for which the C<pragma> method
  returns true, or the loading (and unloading via no) of modules.
  
  =head1 METHODS
  
  C<PPI::Statement::Include> has a number of methods in addition to the standard
  L<PPI::Statement>, L<PPI::Node> and L<PPI::Element> methods.
  
  =cut
  
  use strict;
  use PPI::Statement                 ();
  use PPI::Statement::Include::Perl6 ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Statement';
  }
  
  =pod
  
  =head2 type
  
  The C<type> method returns the general type of statement (C<'use'>, C<'no'>
  or C<'require'>).
  
  Returns the type as a string, or C<undef> if the type cannot be detected.
  
  =begin testing type 9
  
  my $document = PPI::Document->new(\<<'END_PERL');
  require 5.6;
  require Module;
  require 'Module.pm';
  use 5.6;
  use Module;
  use Module 1.00;
  no Module;
  END_PERL
  
  isa_ok( $document, 'PPI::Document' );
  my $statements = $document->find('PPI::Statement::Include');
  is( scalar(@$statements), 7, 'Found 7 include statements' );
  my @expected = qw{ require require require use use use no };
  foreach ( 0 .. 6 ) {
  	is( $statements->[$_]->type, $expected[$_], "->type $_ ok" );
  }
  
  =end testing
  
  =cut
  
  sub type {
  	my $self    = shift;
  	my $keyword = $self->schild(0) or return undef;
  	$keyword->isa('PPI::Token::Word') and $keyword->content;
  }
  
  =pod
  
  =head2 module
  
  The C<module> method returns the module name specified in any include
  statement. This C<includes> pragma names, because pragma are implemented
  as modules. (And lets face it, the definition of a pragma can be fuzzy
  at the best of times in any case)
  
  This covers all of these...
  
    use strict;
    use My::Module;
    no strict;
    require My::Module;
  
  ...but does not cover any of these...
  
    use 5.006;
    require 5.005;
    require "explicit/file/name.pl";
  
  Returns the module name as a string, or C<undef> if the include does
  not specify a module name.
  
  =cut
  
  sub module {
  	my $self = shift;
  	my $module = $self->schild(1) or return undef;
  	$module->isa('PPI::Token::Word') and $module->content;
  }
  
  =pod
  
  =head2 module_version
  
  The C<module_version> method returns the minimum version of the module
  required by the statement, if there is one.
  
  =begin testing module_version 9
  
  my $document = PPI::Document->new(\<<'END_PERL');
  use Integer::Version 1;
  use Float::Version 1.5;
  use Version::With::Argument 1 2;
  use No::Version;
  use No::Version::With::Argument 'x';
  use No::Version::With::Arguments 1, 2;
  use 5.005;
  END_PERL
  
  isa_ok( $document, 'PPI::Document' );
  my $statements = $document->find('PPI::Statement::Include');
  is( scalar @{$statements}, 7, 'Found expected include statements.' );
  is( $statements->[0]->module_version, 1, 'Integer version' );
  is( $statements->[1]->module_version, 1.5, 'Float version' );
  is( $statements->[2]->module_version, 1, 'Version and argument' );
  is( $statements->[3]->module_version, undef, 'No version, no arguments' );
  is( $statements->[4]->module_version, undef, 'No version, with argument' );
  is( $statements->[5]->module_version, undef, 'No version, with arguments' );
  is( $statements->[6]->module_version, undef, 'Version include, no module' );
  
  =end testing
  
  =cut
  
  sub module_version {
  	my $self     = shift;
  	my $argument = $self->schild(3);
  	if ( $argument and $argument->isa('PPI::Token::Operator') ) {
  		return undef;
  	}
  
  	my $version = $self->schild(2) or return undef;
  	return undef unless $version->isa('PPI::Token::Number');
  
  	return $version;
  }
  
  =pod
  
  =head2 pragma
  
  The C<pragma> method checks for an include statement's use as a
  pragma, and returns it if so.
  
  Or at least, it claims to. In practice it's a lot harder to say exactly
  what is or isn't a pragma, because the definition is fuzzy.
  
  The C<intent> of a pragma is to modify the way in which the parser works.
  This is done though the use of modules that do various types of internals
  magic.
  
  For now, PPI assumes that any "module name" that is only a set of
  lowercase letters (and perhaps numbers, like C<use utf8;>). This
  behaviour is expected to change, most likely to something that knows
  the specific names of the various "pragmas".
  
  Returns the name of the pragma, or false ('') if the include is not a
  pragma.
  
  =cut
  
  sub pragma {
  	my $self   = shift;
  	my $module = $self->module or return '';
  	$module =~ /^[a-z][a-z\d]*$/ ? $module : '';
  }
  
  =pod
  
  =head2 version
  
  The C<version> method checks for an include statement that introduces a
  dependency on the version of C<perl> the code is compatible with.
  
  This covers two specific statements.
  
    use 5.006;
    require 5.006;
  
  Currently the version is returned as a string, although in future the version
  may be returned as a L<version> object.  If you want a numeric representation,
  use C<version_literal()>.  Returns false if the statement is not a version
  dependency.
  
  =begin testing version 13
  
  my $document = PPI::Document->new(\<<'END_PERL');
  # Examples from perlfunc in 5.10.
  use v5.6.1;
  use 5.6.1;
  use 5.006_001;
  use 5.006; use 5.6.1;
  
  # Same, but using require.
  require v5.6.1;
  require 5.6.1;
  require 5.006_001;
  require 5.006; require 5.6.1;
  
  # Module.
  use Float::Version 1.5;
  END_PERL
  
  isa_ok( $document, 'PPI::Document' );
  my $statements = $document->find('PPI::Statement::Include');
  is( scalar @{$statements}, 11, 'Found expected include statements.' );
  
  is( $statements->[0]->version, 'v5.6.1', 'use v-string' );
  is( $statements->[1]->version, '5.6.1', 'use v-string, no leading "v"' );
  is( $statements->[2]->version, '5.006_001', 'use developer release' );
  is( $statements->[3]->version, '5.006', 'use back-compatible version, followed by...' );
  is( $statements->[4]->version, '5.6.1', '... use v-string, no leading "v"' );
  
  is( $statements->[5]->version, 'v5.6.1', 'require v-string' );
  is( $statements->[6]->version, '5.6.1', 'require v-string, no leading "v"' );
  is( $statements->[7]->version, '5.006_001', 'require developer release' );
  is( $statements->[8]->version, '5.006', 'require back-compatible version, followed by...' );
  is( $statements->[9]->version, '5.6.1', '... require v-string, no leading "v"' );
  
  is( $statements->[10]->version, '', 'use module version' );
  
  =end testing
  
  =cut
  
  sub version {
  	my $self    = shift;
  	my $version = $self->schild(1) or return undef;
  	$version->isa('PPI::Token::Number') ? $version->content : '';
  }
  
  =pod
  
  =head2 version_literal
  
  The C<version_literal> method has the same behavior as C<version()>, but the
  version is returned as a numeric literal.  Returns false if the statement is
  not a version dependency.
  
  =begin testing version_literal 13
  
  my $document = PPI::Document->new(\<<'END_PERL');
  # Examples from perlfunc in 5.10.
  use v5.6.1;
  use 5.6.1;
  use 5.006_001;
  use 5.006; use 5.6.1;
  
  # Same, but using require.
  require v5.6.1;
  require 5.6.1;
  require 5.006_001;
  require 5.006; require 5.6.1;
  
  # Module.
  use Float::Version 1.5;
  END_PERL
  
  isa_ok( $document, 'PPI::Document' );
  my $statements = $document->find('PPI::Statement::Include');
  is( scalar @{$statements}, 11, 'Found expected include statements.' );
  
  is( $statements->[0]->version_literal, v5.6.1, 'use v-string' );
  is( $statements->[1]->version_literal, 5.6.1, 'use v-string, no leading "v"' );
  is( $statements->[2]->version_literal, 5.006_001, 'use developer release' );
  is( $statements->[3]->version_literal, 5.006, 'use back-compatible version, followed by...' );
  is( $statements->[4]->version_literal, 5.6.1, '... use v-string, no leading "v"' );
  
  is( $statements->[5]->version_literal, v5.6.1, 'require v-string' );
  is( $statements->[6]->version_literal, 5.6.1, 'require v-string, no leading "v"' );
  is( $statements->[7]->version_literal, 5.006_001, 'require developer release' );
  is( $statements->[8]->version_literal, 5.006, 'require back-compatible version, followed by...' );
  is( $statements->[9]->version_literal, 5.6.1, '... require v-string, no leading "v"' );
  
  is( $statements->[10]->version_literal, '', 'use module version' );
  
  =end testing
  
  =cut
  
  sub version_literal {
  	my $self    = shift;
  	my $version = $self->schild(1) or return undef;
  	$version->isa('PPI::Token::Number') ? $version->literal : '';
  }
  
  =pod
  
  The C<arguments> method gives you the rest of the statement after the the
  module/pragma and module version, i.e. the stuff that will be used to
  construct what gets passed to the module's C<import()> subroutine.  This does
  include the comma, etc. operators, but doesn't include non-significant direct
  children or any final semicolon.
  
  =begin testing arguments 19
  
  my $document = PPI::Document->new(\<<'END_PERL');
  use 5.006;       # Don't expect anything.
  use Foo;         # Don't expect anything.
  use Foo 5;       # Don't expect anything.
  use Foo 'bar';   # One thing.
  use Foo 5 'bar'; # One thing.
  use Foo qw< bar >, "baz";
  use Test::More tests => 5 * 9   # Don't get tripped up by the lack of the ";"
  END_PERL
  
  isa_ok( $document, 'PPI::Document' );
  my $statements = $document->find('PPI::Statement::Include');
  is( scalar @{$statements}, 7, 'Found expected include statements.' );
  
  is(
  	scalar $statements->[0]->arguments, undef, 'arguments for perl version',
  );
  is(
  	scalar $statements->[1]->arguments,
  	undef,
  	'arguments with no arguments',
  );
  is(
  	scalar $statements->[2]->arguments,
  	undef,
  	'arguments with no arguments but module version',
  );
  
  my @arguments = $statements->[3]->arguments;
  is( scalar @arguments, 1, 'arguments with single argument' );
  is( $arguments[0]->content, q<'bar'>, 'arguments with single argument' );
  
  @arguments = $statements->[4]->arguments;
  is(
  	scalar @arguments,
  	1,
  	'arguments with single argument and module version',
  );
  is(
  	$arguments[0]->content,
  	q<'bar'>,
  	'arguments with single argument and module version',
  );
  
  @arguments = $statements->[5]->arguments;
  is(
  	scalar @arguments,
  	3,
  	'arguments with multiple arguments',
  );
  is(
  	$arguments[0]->content,
  	q/qw< bar >/,
  	'arguments with multiple arguments',
  );
  is(
  	$arguments[1]->content,
  	q<,>,
  	'arguments with multiple arguments',
  );
  is(
  	$arguments[2]->content,
  	q<"baz">,
  	'arguments with multiple arguments',
  );
  
  @arguments = $statements->[6]->arguments;
  is(
  	scalar @arguments,
  	5,
  	'arguments with Test::More',
  );
  is(
  	$arguments[0]->content,
  	'tests',
  	'arguments with Test::More',
  );
  is(
  	$arguments[1]->content,
  	q[=>],
  	'arguments with Test::More',
  );
  is(
  	$arguments[2]->content,
  	5,
  	'arguments with Test::More',
  );
  is(
  	$arguments[3]->content,
  	'*',
  	'arguments with Test::More',
  );
  is(
  	$arguments[4]->content,
  	9,
  	'arguments with Test::More',
  );
  
  =end testing
  
  =cut
  
  sub arguments {
  	my $self = shift;
  	my @args = $self->schildren;
  
  	# Remove the "use", "no" or "require"
  	shift @args;
  
  	# Remove the statement terminator
  	if (
  		$args[-1]->isa('PPI::Token::Structure')
  		and
  		$args[-1]->content eq ';'
  	) {
  		pop @args;
  	}
  
  	# Remove the module or perl version.
  	shift @args;  
  
  	return unless @args;
  
  	if ( $args[0]->isa('PPI::Token::Number') ) {
  		my $after = $args[1] or return;
  		$after->isa('PPI::Token::Operator') or shift @args;
  	}
  
  	return @args;
  }
  
  1;
  
  =pod
  
  =head1 TO DO
  
  - Write specific unit tests for this package
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_STATEMENT_INCLUDE

$fatpacked{"PPI/Statement/Include/Perl6.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_STATEMENT_INCLUDE_PERL6';
  package PPI::Statement::Include::Perl6;
  
  =pod
  
  =head1 NAME
  
  PPI::Statement::Include::Perl6 - Inline Perl 6 file section
  
  =head1 SYNOPSIS
  
    use v6-alpha;
    
    grammar My::Grammar {
        ...
    }
  
  =head1 INHERITANCE
  
    PPI::Statement::Include::Perl6
    isa PPI::Statement::Include
        isa PPI::Statement
            isa PPI::Node
                isa PPI::Element
  
  =head1 DESCRIPTION
  
  A C<PPI::Statement::Include::Perl6> is a special include statement that
  indicates the start of a section of Perl 6 code inlined into a regular
  Perl 5 code file.
  
  The primary purpose of the class is to allow L<PPI> to provide at least
  basic support for "6 in 5" modules like v6.pm;
  
  Currently, PPI only supports starting a Perl 6 block. It does not
  currently support changing back to Perl 5 again. Additionally all POD
  and __DATA__ blocks and __END__ blocks will be included in the Perl 6
  string and will not be parsed by PPI.
  
  =cut
  
  use strict;
  use PPI::Statement::Include ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Statement::Include';
  }
  
  =pod
  
  =head2 perl6
  
  The C<perl6> method returns the block of Perl 6 code that is attached to
  the "use v6...;" command.
  
  =cut
  
  sub perl6 {
  	$_[0]->{perl6};
  }
  
  1;
  
  =pod
  
  =head1 TO DO
  
  - Write specific unit tests for this package
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_STATEMENT_INCLUDE_PERL6

$fatpacked{"PPI/Statement/Null.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_STATEMENT_NULL';
  package PPI::Statement::Null;
  
  =pod
  
  =head1 NAME
  
  PPI::Statement::Null - A useless null statement
  
  =head1 SYNOPSIS
  
    my $foo = 1;
    
    ; # <-- Null statement
    
    my $bar = 1;
  
  =head1 INHERITANCE
  
    PPI::Statement::Null
    isa PPI::Statement
        isa PPI::Node
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  C<PPI::Statement::Null> is a utility class designed to handle situations
  where PPI encounters a naked statement separator.
  
  Although strictly speaking, the semicolon is a statement B<separator>
  and not a statement B<terminator>, PPI considers a semicolon to be a
  statement terminator under most circumstances.
  
  In any case, the null statement has no purpose, and can be safely deleted
  with no ill effect.
  
  =head1 METHODS
  
  C<PPI::Statement::Null> has no additional methods beyond the default ones
  provided by L<PPI::Statement>, L<PPI::Node> and L<PPI::Element>.
  
  =cut
  
  use strict;
  use PPI::Statement ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Statement';
  }
  
  # A null statement is not significant
  sub significant { '' }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_STATEMENT_NULL

$fatpacked{"PPI/Statement/Package.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_STATEMENT_PACKAGE';
  package PPI::Statement::Package;
  
  =pod
  
  =head1 NAME
  
  PPI::Statement::Package - A package statement
  
  =head1 INHERITANCE
  
    PPI::Statement::Package
    isa PPI::Statement
        isa PPI::Node
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  Most L<PPI::Statement> subclasses are assigned based on the value of the
  first token or word found in the statement. When PPI encounters a statement
  starting with 'package', it converts it to a C<PPI::Statement::Package>
  object.
  
  When working with package statements, please remember that packages only
  exist within their scope, and proper support for scoping has yet to be
  completed in PPI.
  
  However, if the immediate parent of the package statement is the
  top level L<PPI::Document> object, then it can be considered to define
  everything found until the next top-level "file scoped" package statement.
  
  A file may, however, contain nested temporary package, in which case you
  are mostly on your own :)
  
  
  =begin testing hash_constructors_dont_contain_packages_rt52259 2
  
  my $Document = PPI::Document->new(\<<'END_PERL');
  {    package  => "", };
  +{   package  => "", };
  {   'package' => "", };
  +{  'package' => "", };
  {   'package' ,  "", };
  +{  'package' ,  "", };
  END_PERL
  
  isa_ok( $Document, 'PPI::Document' );
  
  my $packages = $Document->find('PPI::Statement::Package');
  my $test_name = 'Found no package statements in hash constructors - RT #52259';
  if (not $packages) {
  	pass $test_name;
  } elsif ( not is(scalar @{$packages}, 0, $test_name) ) {
  	diag 'Package statements found:';
  	diag $_->parent()->parent()->content() foreach @{$packages};
  }
  
  =end testing
  
  
  =head1 METHODS
  
  C<PPI::Statement::Package> has a number of methods in addition to the standard
  L<PPI::Statement>, L<PPI::Node> and L<PPI::Element> methods.
  
  =cut
  
  use strict;
  use PPI::Statement ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Statement';
  }
  
  =pod
  
  =head2 namespace
  
  Most package declarations are simple, and just look something like
  
    package Foo::Bar;
  
  The C<namespace> method returns the name of the declared package, in the
  above case 'Foo::Bar'. It returns this exactly as written and does not
  attempt to clean up or resolve things like ::Foo to main::Foo.
  
  If the package statement is done any different way, it returns false.
  
  =cut
  
  sub namespace {
  	my $self = shift;
  	my $namespace = $self->schild(1) or return '';
  	$namespace->isa('PPI::Token::Word')
  		? $namespace->content
  		: '';
  }
  
  =pod
  
  =head2 file_scoped
  
  Regardless of whether it is named or not, the C<file_scoped> method will
  test to see if the package declaration is a top level "file scoped"
  statement or not, based on its location.
  
  In general, returns true if it is a "file scoped" package declaration with
  an immediate parent of the top level Document, or false if not.
  
  Note that if the PPI DOM tree B<does not> have a PPI::Document object at
  as the root element, this will return false. Likewise, it will also return
  false if the root element is a L<PPI::Document::Fragment>, as a fragment of
  a file does not represent a scope.
  
  =cut
  
  sub file_scoped {
  	my $self     = shift;
  	my ($Parent, $Document) = ($self->parent, $self->top);
  	$Parent and $Document and $Parent == $Document
  	and $Document->isa('PPI::Document')
  	and ! $Document->isa('PPI::Document::Fragment');
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_STATEMENT_PACKAGE

$fatpacked{"PPI/Statement/Scheduled.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_STATEMENT_SCHEDULED';
  package PPI::Statement::Scheduled;
  
  =pod
  
  =head1 NAME
  
  PPI::Statement::Scheduled - A scheduled code block
  
  =head1 INHERITANCE
  
    PPI::Statement::Scheduled
    isa PPI::Statement::Sub
        isa PPI::Statement
            isa PPI::Node
                isa PPI::Element
  
  =head1 DESCRIPTION
  
  A scheduled code block is one that is intended to be run at a specific
  time during the loading process.
  
  There are five types of scheduled block:
  
    BEGIN {
    	# Executes as soon as this block is fully defined
    	...
    }
  
    CHECK {
    	# Executes after overall compile-phase in reverse order
    	...
    }
  
    UNITCHECK {
    	# Executes after compile-phase of individual module in reverse order
    	...
    }
  
    INIT {
    	# Executes just before run-time
    	...
    }
  
    END {
    	# Executes as late as possible in reverse order
    	...
    }
  
  Technically these scheduled blocks are actually subroutines, and in fact
  may have 'sub' in front of them.
  
  =head1 METHODS
  
  =cut
  
  use strict;
  use PPI::Statement::Sub ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Statement::Sub';
  }
  
  sub __LEXER__normal { '' }
  
  sub _complete {
  	my $child = $_[0]->schild(-1);
  	return !! (
  		defined $child
  		and
  		$child->isa('PPI::Structure::Block')
  		and
  		$child->complete
  	);
  }
  
  =pod
  
  =head2 type
  
  The C<type> method returns the type of scheduled block, which should always be
  one of C<'BEGIN'>, C<'CHECK'>, C<'UNITCHECK'>, C<'INIT'> or C<'END'>.
  
  =cut
  
  sub type {
  	my $self     = shift;
  	my @children = $self->schildren or return undef;
  	$children[0]->content eq 'sub'
  		? $children[1]->content
  		: $children[0]->content;
  }
  
  # This is actually the same as Sub->name
  sub name {
  	shift->type(@_);
  }
  
  1;
  
  =pod
  
  =head1 TO DO
  
  - Write unit tests for this package
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_STATEMENT_SCHEDULED

$fatpacked{"PPI/Statement/Sub.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_STATEMENT_SUB';
  package PPI::Statement::Sub;
  
  =pod
  
  =head1 NAME
  
  PPI::Statement::Sub - Subroutine declaration
  
  =head1 INHERITANCE
  
    PPI::Statement::Sub
    isa PPI::Statement
        isa PPI::Node
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  Except for the special BEGIN, CHECK, UNITCHECK, INIT, and END subroutines
  (which are part of L<PPI::Statement::Scheduled>) all subroutine declarations
  are lexed as a PPI::Statement::Sub object.
  
  Primarily, this means all of the various C<sub foo {}> statements, but also
  forward declarations such as C<sub foo;> or C<sub foo($);>. It B<does not>
  include anonymous subroutines, as these are merely part of a normal statement.
  
  =head1 METHODS
  
  C<PPI::Statement::Sub> has a number of methods in addition to the standard
  L<PPI::Statement>, L<PPI::Node> and L<PPI::Element> methods.
  
  =cut
  
  use strict;
  use List::Util     ();
  use Params::Util   qw{_INSTANCE};
  use PPI::Statement ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Statement';
  }
  
  # Lexer clue
  sub __LEXER__normal { '' }
  
  sub _complete {
  	my $child = $_[0]->schild(-1);
  	return !! (
  		defined $child
  		and
  		$child->isa('PPI::Structure::Block')
  		and
  		$child->complete
  	);
  }
  
  
  
  
  
  #####################################################################
  # PPI::Statement::Sub Methods
  
  =pod
  
  =head2 name
  
  The C<name> method returns the name of the subroutine being declared.
  
  In some rare cases such as a naked C<sub> at the end of the file, this may return
  false.
  
  =cut
  
  sub name {
  	my $self = shift;
  
  	# The second token should be the name, if we have one
  	my $Token = $self->schild(1) or return '';
  	$Token->isa('PPI::Token::Word') and $Token->content;
  }
  
  =pod
  
  =head2 prototype
  
  If it has one, the C<prototype> method returns the subroutine's prototype.
  It is returned in the same format as L<PPI::Token::Prototype/prototype>,
  cleaned and removed from its brackets.
  
  Returns false if the subroutine does not define a prototype
  
  =cut
  
  sub prototype {
  	my $self      = shift;
  	my $Prototype = List::Util::first {
  		_INSTANCE($_, 'PPI::Token::Prototype')
  	} $self->children;
  	defined($Prototype) ? $Prototype->prototype : '';
  }
  
  =pod
  
  =head2 block
  
  With its name and implementation shared with L<PPI::Statement::Scheduled>,
  the C<block> method finds and returns the actual Structure object of the
  code block for this subroutine.
  
  Returns false if this is a forward declaration, or otherwise does not have a
  code block.
  
  =cut
  
  sub block {
  	my $self = shift;
  	my $lastchild = $self->schild(-1) or return '';
  	$lastchild->isa('PPI::Structure::Block') and $lastchild;
  }
  
  =pod
  
  =head2 forward
  
  The C<forward> method returns true if the subroutine declaration is a
  forward declaration.
  
  That is, it returns false if the subroutine has a code block, or true
  if it does not.
  
  =cut
  
  sub forward {
  	! shift->block;
  }
  
  =pod
  
  =head2 reserved
  
  The C<reserved> method provides a convenience method for checking to see
  if this is a special reserved subroutine. It does not check against any
  particular list of reserved sub names, but just returns true if the name
  is all uppercase, as defined in L<perlsub>.
  
  Note that in the case of BEGIN, CHECK, UNITCHECK, INIT and END, these will be
  defined as L<PPI::Statement::Scheduled> objects, not subroutines.
  
  Returns true if it is a special reserved subroutine, or false if not.
  
  =cut
  
  sub reserved {
  	my $self = shift;
  	my $name = $self->name or return '';
  	$name eq uc $name;
  }
  
  1;
  
  =pod
  
  =head1 TO DO
  
  - Write unit tests for this package
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_STATEMENT_SUB

$fatpacked{"PPI/Statement/Unknown.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_STATEMENT_UNKNOWN';
  package PPI::Statement::Unknown;
  
  =pod
  
  =head1 NAME
  
  PPI::Statement::Unknown - An unknown or transient statement
  
  =head1 INHERITANCE
  
    PPI::Statement::Unknown
    isa PPI::Statement
        isa PPI::Node
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  The C<PPI::Statement::Unknown> class is used primarily during the lexing
  process to hold elements that are known to be statement, but for which
  the exact C<type> of statement is as yet unknown, and requires further
  tokens in order to resolve the correct type.
  
  They should not exist in a fully parse B<valid> document, and if any
  exists they indicate either a problem in Document, or possibly (by
  allowing it to get through unresolved) a bug in L<PPI::Lexer>.
  
  =head1 METHODS
  
  C<PPI::Statement::Unknown> has no additional methods beyond the
  default ones provided by L<PPI::Statement>, L<PPI::Node> and
  L<PPI::Element>.
  
  =cut
  
  use strict;
  use PPI::Statement ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Statement';
  }
  
  # If one of these ends up in the final document,
  # we're pretty much screwed. Just call it a day.
  sub _complete () { 1 }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_STATEMENT_UNKNOWN

$fatpacked{"PPI/Statement/UnmatchedBrace.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_STATEMENT_UNMATCHEDBRACE';
  package PPI::Statement::UnmatchedBrace;
  
  =pod
  
  =head1 NAME
  
  PPI::Statement::UnmatchedBrace - Isolated unmatched brace
  
  =head1 SYNOPSIS
  
    sub foo {
        1;
    }
    
    } # <--- This is an unmatched brace
  
  =head1 INHERITANCE
  
    PPI::Statement::UnmatchedBrace
    isa PPI::Statement
        isa PPI::Node
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  The C<PPI::Statement::UnmatchedBrace> class is a miscellaneous utility
  class. Objects of this type should be rare, or not exist at all in normal
  valid L<PPI::Document> objects.
  
  It can be either a round ')', square ']' or curly '}' brace, this class
  does not distinguish. Objects of this type are only allocated at a
  structural level, not a lexical level (as they are lexically invalid
  anyway).
  
  The presence of a C<PPI::Statement::UnmatchedBrace> indicated a broken
  or invalid document. Or maybe a bug in PPI, but B<far> more likely a
  broken Document. :)
  
  =head1 METHODS
  
  C<PPI::Statement::UnmatchedBrace> has no additional methods beyond the
  default ones provided by L<PPI::Statement>, L<PPI::Node> and
  L<PPI::Element>.
  
  =cut
  
  use strict;
  use PPI::Statement ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Statement';
  }
  
  # Once we've hit a naked unmatched brace we can never truly be complete.
  # So instead we always just call it a day...
  sub _complete () { 1 }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_STATEMENT_UNMATCHEDBRACE

$fatpacked{"PPI/Statement/Variable.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_STATEMENT_VARIABLE';
  package PPI::Statement::Variable;
  
  =pod
  
  =head1 NAME
  
  PPI::Statement::Variable - Variable declaration statements
  
  =head1 SYNOPSIS
  
    # All of the following are variable declarations
    my $foo = 1;
    my ($foo, $bar) = (1, 2);
    our $foo = 1;
    local $foo;
    local $foo = 1;
    LABEL: my $foo = 1;
  
  =head1 INHERITANCE
  
    PPI::Statement::Variable
    isa PPI::Statement::Expression
        isa PPI::Statement
            isa PPI::Node
                isa PPI::Element
  
  =head1 DESCRIPTION
  
  The main intent of the C<PPI::Statement::Variable> class is to describe
  simple statements that explicitly declare new local or global variables.
  
  Note that this does not make it exclusively the only place where variables
  are defined, and later on you should expect that the C<variables> method
  will migrate deeper down the tree to either L<PPI::Statement> or
  L<PPI::Node> to recognise this fact, but for now it stays here.
  
  =head1 METHODS
  
  =cut
  
  use strict;
  use Params::Util               qw{_INSTANCE};
  use PPI::Statement::Expression ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Statement::Expression';
  }
  
  =pod
  
  =head2 type
  
  The C<type> method checks and returns the declaration type of the statement,
  which will be one of 'my', 'local', 'our', or 'state'.
  
  Returns a string of the type, or C<undef> if the type cannot be detected
  (which is probably a bug).
  
  =cut
  
  sub type {
  	my $self = shift;
  
  	# Get the first significant child
  	my @schild = grep { $_->significant } $self->children;
  
  	# Ignore labels
  	shift @schild if _INSTANCE($schild[0], 'PPI::Token::Label');
  
  	# Get the type
  	(_INSTANCE($schild[0], 'PPI::Token::Word') and $schild[0]->content =~ /^(my|local|our|state)$/)
  		? $schild[0]->content
  		: undef;
  }
  
  =pod
  
  =head2 variables
  
  As for several other PDOM Element types that can declare variables, the
  C<variables> method returns a list of the canonical forms of the variables
  defined by the statement.
  
  Returns a list of the canonical string forms of variables, or the null list
  if it is unable to find any variables.
  
  =begin testing variables
  
  # Test the things we assert to work in the synopsis
  my $Document = PPI::Document->new(\<<'END_PERL');
  package Bar;
  my $foo = 1;
  my ( $foo, $bar) = (1, 2);
  our $foo = 1;
  local $foo;
  local $foo = 1;
  LABEL: my $foo = 1;
  
  # As well as those basics, lets also try some harder ones
  local($foo = $bar->$bar(), $bar);
  END_PERL
  isa_ok( $Document, 'PPI::Document' );
  
  # There should be 6 statement objects
  my $ST = $Document->find('Statement::Variable');
  is( ref($ST), 'ARRAY', 'Found statements' );
  is( scalar(@$ST), 7, 'Found 7 ::Variable objects' );
  foreach my $Var ( @$ST ) {
  	isa_ok( $Var, 'PPI::Statement::Variable' );
  }
  is_deeply( [ $ST->[0]->variables ], [ '$foo' ],         '1: Found $foo' );
  is_deeply( [ $ST->[1]->variables ], [ '$foo', '$bar' ], '2: Found $foo and $bar' );
  is_deeply( [ $ST->[2]->variables ], [ '$foo' ],         '3: Found $foo' );
  is_deeply( [ $ST->[3]->variables ], [ '$foo' ],         '4: Found $foo' );
  is_deeply( [ $ST->[4]->variables ], [ '$foo' ],         '5: Found $foo' );
  is_deeply( [ $ST->[5]->variables ], [ '$foo' ],         '6: Found $foo' );
  is_deeply( [ $ST->[6]->variables ], [ '$foo', '$bar' ], '7: Found $foo and $bar' );
  
  =end testing
  
  =cut
  
  sub variables {
  	map { $_->canonical } $_[0]->symbols;
  }
  
  =pod
  
  =head2 symbols
  
  Returns a list of the variables defined by the statement, as
  L<PPI::Token::Symbol>s.
  
  =cut
  
  sub symbols {
  	my $self = shift;
  
  	# Get the children we care about
  	my @schild = grep { $_->significant } $self->children;
  	shift @schild if _INSTANCE($schild[0], 'PPI::Token::Label');
  
  	# If the second child is a symbol, return its name
  	if ( _INSTANCE($schild[1], 'PPI::Token::Symbol') ) {
  		return $schild[1];
  	}
  
  	# If it's a list, return as a list
  	if ( _INSTANCE($schild[1], 'PPI::Structure::List') ) {
  		my $Expression = $schild[1]->schild(0);
  		$Expression and
  		$Expression->isa('PPI::Statement::Expression') or return ();
  
  		# my and our are simpler than local
  		if (
  			$self->type eq 'my'
  			or
  			$self->type eq 'our'
  			or
  			$self->type eq 'state'
  		) {
  			return grep {
  				$_->isa('PPI::Token::Symbol')
  			} $Expression->schildren;
  		}
  
  		# Local is much more icky (potentially).
  		# Not that we are actually going to deal with it now,
  		# but having this seperate is likely going to be needed
  		# for future bug reports about local() things.
  
  		# This is a slightly better way to check.
  		return grep {
  			$self->_local_variable($_)
  		} grep {
  			$_->isa('PPI::Token::Symbol')
  		} $Expression->schildren;
  	}
  
  	# erm... this is unexpected
  	();
  }
  
  sub _local_variable {
  	my ($self, $el) = @_;
  
  	# The last symbol should be a variable
  	my $n = $el->snext_sibling or return 1;
  	my $p = $el->sprevious_sibling;
  	if ( ! $p or $p eq ',' ) {
  		# In the middle of a list
  		return 1 if $n eq ',';
  
  		# The first half of an assignment
  		return 1 if $n eq '=';
  	}
  
  	# Lets say no for know... additional work
  	# should go here.
  	return '';
  }
  
  1;
  
  =pod
  
  =head1 TO DO
  
  - Write unit tests for this
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_STATEMENT_VARIABLE

$fatpacked{"PPI/Statement/When.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_STATEMENT_WHEN';
  package PPI::Statement::When;
  
  =pod
  
  =head1 NAME
  
  PPI::Statement::When - Describes all compound statements
  
  =head1 SYNOPSIS
  
    foreach ( qw/ foo bar baz / ) {
        when ( m/b/ ) {
            boing($_);
        }
        when ( m/f/ ) {
            boom($_);
        }
        default {
            tchak($_);
        }
    }
  
  =head1 INHERITANCE
  
    PPI::Statement::When
    isa PPI::Statement
        isa PPI::Node
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  C<PPI::Statement::When> objects are used to describe when and default
  statements, as described in L<perlsyn>.
  
  =head1 METHODS
  
  C<PPI::Structure::When> has no methods beyond those provided by the
  standard L<PPI::Structure>, L<PPI::Node> and L<PPI::Element> methods.
  
  Got any ideas for methods? Submit a report to rt.cpan.org!
  
  =cut
  
  use strict;
  use PPI::Statement ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Statement';
  }
  
  # Lexer clues
  sub __LEXER__normal { '' }
  
  sub _complete {
  	my $child = $_[0]->schild(-1);
  	return !! (
  		defined $child
  		and
  		$child->isa('PPI::Structure::Block')
  		and
  		$child->complete
  	);
  }
  
  
  
  
  
  #####################################################################
  # PPI::Node Methods
  
  sub scope {
  	1;
  }
  
  1;
  
  =pod
  
  =head1 TO DO
  
  - Write unit tests for this package
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_STATEMENT_WHEN

$fatpacked{"PPI/Structure.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_STRUCTURE';
  package PPI::Structure;
  
  =pod
  
  =head1 NAME
  
  PPI::Structure - The base class for Perl braced structures
  
  =head1 INHERITANCE
  
    PPI::Structure
    isa PPI::Node
        isa PPI::Element
  
  =head1 DESCRIPTION
  
  PPI::Structure is the root class for all Perl bracing structures. This
  covers all forms of C< [ ... ] >, C< { ... } >, and C< ( ... ) > brace
  types, and includes cases where only one half of the pair exist.
  
  The class PPI::Structure itself is full abstract and no objects of that
  type should actually exist in the tree.
  
  =head2 Elements vs Children
  
  A B<PPI::Structure> has an unusual existance. Unlike a L<PPI::Document>
  or L<PPI::Statement>, which both simply contain other elements, a
  structure B<both> contains and consists of content.
  
  That is, the brace tokens are B<not> considered to be "children" of the
  structure, but are part of it.
  
  In practice, this will mean that while the -E<gt>elements and -E<gt>tokens
  methods (and related) B<will> return a list with the brace tokens at either
  end, the -E<gt>children method explicitly will B<not> return the brace.
  
  =head1 STRUCTURE CLASSES
  
  Excluding the transient L<PPI::Structure::Unknown> that exists briefly
  inside the parser, there are eight types of structure.
  
  =head2 L<PPI::Structure::List>
  
  This covers all round braces used for function arguments, in C<foreach>
  loops, literal lists, and braces used for precedence-ordering purposes.
  
  =head2 L<PPI::Structure::For>
  
  Although B<not> used for the C<foreach> loop list, this B<is> used for
  the special case of the round-brace three-part semicolon-seperated C<for>
  loop expression (the traditional C style for loop).
  
  =head2 L<PPI::Structure::Given>
  
  This is for the expression being matched in switch statements.
  
  =head2 L<PPI::Structure::When>
  
  This is for the matching expression in "when" statements.
  
  =head2 L<PPI::Structure::Condition>
  
  This round-brace structure covers boolean conditional braces, such as
  for C<if> and C<while> blocks.
  
  =head2 L<PPI::Structure::Block>
  
  This curly-brace and common structure is used for all form of code
  blocks. This includes those for C<if>, C<do> and similar, as well
  as C<grep>, C<map>, C<sort>, C<sub> and (labelled or anonymous) 
  scoping blocks.
  
  =head2 L<PPI::Structure::Constructor>
  
  This class covers brace structures used for the construction of
  anonymous C<ARRAY> and C<HASH> references.
  
  =head2 L<PPI::Structure::Subscript>
  
  This class covers square-braces and curly-braces used after a
  -E<gt> pointer to access the subscript of an C<ARRAY> or C<HASH>.
  
  =head1 METHODS
  
  C<PPI::Structure> itself has very few methods. Most of the time, you will be
  working with the more generic L<PPI::Element> or L<PPI::Node> methods, or one
  of the methods that are subclass-specific.
  
  =cut
  
  use strict;
  use Scalar::Util   ();
  use Params::Util   qw{_INSTANCE};
  use PPI::Node      ();
  use PPI::Exception ();
  
  use vars qw{$VERSION @ISA *_PARENT};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Node';
  	*_PARENT = *PPI::Element::_PARENT;
  }
  
  use PPI::Structure::Block       ();
  use PPI::Structure::Condition   ();
  use PPI::Structure::Constructor ();
  use PPI::Structure::For         ();
  use PPI::Structure::Given       ();
  use PPI::Structure::List        ();
  use PPI::Structure::Subscript   ();
  use PPI::Structure::Unknown     ();
  use PPI::Structure::When        ();
  
  
  
  
  
  #####################################################################
  # Constructor
  
  sub new {
  	my $class = shift;
  	my $Token = PPI::Token::__LEXER__opens($_[0]) ? shift : return undef;
  
  	# Create the object
  	my $self = bless {
  		children => [],
  		start    => $Token,
  		}, $class;
  
  	# Set the start braces parent link
  	Scalar::Util::weaken(
  		$_PARENT{Scalar::Util::refaddr $Token} = $self
  	);
  
  	$self;
  }
  
  
  
  
  
  #####################################################################
  # PPI::Structure API methods
  
  =pod
  
  =head2 start
  
  For lack of better terminology (like "open" and "close") that has not
  already in use for some other more important purpose, the two individual
  braces for the structure are known within PPI as the "start" and "finish"
  braces (at least for method purposes).
  
  The C<start> method returns the start brace for the structure (i.e. the
  opening brace).
  
  Returns the brace as a L<PPI::Token::Structure> or C<undef> if the
  structure does not have a starting brace.
  
  Under normal parsing circumstances this should never occur, but may happen
  due to manipulation of the PDOM tree.
  
  =cut
  
  sub start  { $_[0]->{start}  }
  
  =pod
  
  =head2 finish
  
  The C<finish> method returns the finish brace for the structure (i.e. the
  closing brace).
  
  Returns the brace as a L<PPI::Token::Structure> or C<undef> if the
  structure does not have a finishing brace. This can be quite common if
  the document is not complete (for example, from an editor where the user
  may be halfway through typeing a subroutine).
  
  =cut
  
  sub finish { $_[0]->{finish} }
  
  =pod
  
  =head2 braces
  
  The C<braces> method is a utility method which returns the brace type,
  regardless of whether has both braces defined, or just the starting
  brace, or just the ending brace.
  
  Returns on of the three strings C<'[]'>, C<'{}'>, or C<'()'>, or C<undef>
  on error (primarily not having a start brace, as mentioned above).
  
  =cut
  
  sub braces {
  	my $self = $_[0]->{start} ? shift : return undef;
  	return {
  		'[' => '[]',
  		'(' => '()',
  		'{' => '{}',
  	}->{ $self->{start}->{content} };
  }
  
  =pod
  
  =head1 complete
  
  The C<complete> method is a convenience method that returns true if
  the both braces are defined for the structure, or false if only one
  brace is defined.
  
  Unlike the top level C<complete> method which checks for completeness
  in depth, the structure complete method ONLY confirms completeness
  for the braces, and does not recurse downwards.
  
  =cut
  
  sub complete {
  	!! ($_[0]->{start} and $_[0]->{finish});
  }
  
  
  
  
  
  #####################################################################
  # PPI::Node overloaded methods
  
  # For us, the "elements" concept includes the brace tokens
  sub elements {
  	my $self = shift;
  
  	if ( wantarray ) {
  		# Return a list in array context
  		return ( $self->{start} || (), @{$self->{children}}, $self->{finish} || () );
  	} else {
  		# Return the number of elements in scalar context.
  		# This is memory-cheaper than creating another big array
  		return scalar(@{$self->{children}})
  			+ ($self->{start}  ? 1 : 0)
  			+ ($self->{finish} ? 1 : 0);
  	}
  }
  
  # For us, the first element is probably the opening brace
  sub first_element {
  	# Technically, if we have no children and no opening brace,
  	# then the first element is the closing brace.
  	$_[0]->{start} or $_[0]->{children}->[0] or $_[0]->{finish};
  }
  
  # For us, the last element is probably the closing brace
  sub last_element {
  	# Technically, if we have no children and no closing brace,
  	# then the last element is the opening brace
  	$_[0]->{finish} or $_[0]->{children}->[-1] or $_[0]->{start};
  }
  
  # Location is same as the start token, if any
  sub location {
  	my $self  = shift;
  	my $first = $self->first_element or return undef;
  	$first->location;
  }
  
  
  
  
  
  #####################################################################
  # PPI::Element overloaded methods
  
  # Get the full set of tokens, including start and finish
  sub tokens {
  	my $self = shift;
  	my @tokens = (
  		$self->{start}  || (),
  		$self->SUPER::tokens(@_),
  		$self->{finish} || (),
  		);
  	@tokens;
  }
  
  # Like the token method ->content, get our merged contents.
  # This will recurse downwards through everything
  ### Reimplement this using List::Utils stuff
  sub content {
  	my $self = shift;
  	my $content = $self->{start} ? $self->{start}->content : '';
  	foreach my $child ( @{$self->{children}} ) {
  		$content .= $child->content;
  	}
  	$content .= $self->{finish}->content if $self->{finish};
  	$content;
  }
  
  # Is the structure completed
  sub _complete {
  	!! ( defined $_[0]->{finish} );
  }
  
  # You can insert either another structure, or a token
  sub insert_before {
  	my $self    = shift;
  	my $Element = _INSTANCE(shift, 'PPI::Element') or return undef;
  	if ( $Element->isa('PPI::Structure') ) {
  		return $self->__insert_before($Element);
  	} elsif ( $Element->isa('PPI::Token') ) {
  		return $self->__insert_before($Element);
  	}
  	'';
  }
  
  # As above, you can insert either another structure, or a token
  sub insert_after {
  	my $self    = shift;
  	my $Element = _INSTANCE(shift, 'PPI::Element') or return undef;
  	if ( $Element->isa('PPI::Structure') ) {
  		return $self->__insert_after($Element);
  	} elsif ( $Element->isa('PPI::Token') ) {
  		return $self->__insert_after($Element);
  	}
  	'';
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_STRUCTURE

$fatpacked{"PPI/Structure/Block.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_STRUCTURE_BLOCK';
  package PPI::Structure::Block;
  
  =pod
  
  =head1 NAME
  
  PPI::Structure::Block - Curly braces representing a code block
  
  =head1 SYNOPSIS
  
    sub foo { ... }
    
    grep { ... } @list;
    
    if ( condition ) {
        ...
    }
    
    LABEL: {
        ...
    }
  
  =head1 INHERITANCE
  
    PPI::Structure::Block
    isa PPI::Structure
        isa PPI::Node
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  C<PPI::Structure::Block> is the class used for all curly braces that
  represent code blocks. This includes subroutines, compound statements
  and any other block braces.
  
  =head1 METHODS
  
  C<PPI::Structure::Block> has no methods beyond those provided by the
  standard L<PPI::Structure>, L<PPI::Node> and L<PPI::Element> methods.
  
  Got any ideas for methods? Submit a report to rt.cpan.org!
  
  =cut
  
  use strict;
  use PPI::Structure ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Structure';
  }
  
  
  
  
  
  #####################################################################
  # PPI::Element Methods
  
  # This is a scope boundary
  sub scope { 1 }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_STRUCTURE_BLOCK

$fatpacked{"PPI/Structure/Condition.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_STRUCTURE_CONDITION';
  package PPI::Structure::Condition;
  
  =pod
  
  =head1 NAME
  
  PPI::Structure::Condition - Round braces for boolean context conditions
  
  =head1 SYNOPSIS
  
    if ( condition ) {
        ...
    }
    
    while ( condition ) {
        ...
    }
  
  =head1 INHERITANCE
  
    PPI::Structure::Condition
    isa PPI::Structure
        isa PPI::Node
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  C<PPI::Structure::Condition> is the class used for all round braces
  that represent boolean contexts used in various conditions.
  
  =head1 METHODS
  
  C<PPI::Structure::Condition> has no methods beyond those provided by
  the standard L<PPI::Structure>, L<PPI::Node> and L<PPI::Element> methods.
  
  Got any ideas for methods? Submit a report to rt.cpan.org!
  
  =cut
  
  use strict;
  use PPI::Structure ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Structure';
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_STRUCTURE_CONDITION

$fatpacked{"PPI/Structure/Constructor.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_STRUCTURE_CONSTRUCTOR';
  package PPI::Structure::Constructor;
  
  =pod
  
  =head1 NAME
  
  PPI::Structure::Constructor - Anonymous hash or array constructor
  
  =head1 SYNOPSIS
  
    my $array = [ 'foo', 'bar' ];
    my $hash  = { foo => 'bar' };
  
  =head1 INHERITANCE
  
    PPI::Structure::Constructor
    isa PPI::Structure
        isa PPI::Node
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  C<PPI::Structure::Constructor> is the class used for anonymous C<ARRAY>
  reference of C<HASH> reference constructors.
  
  =head1 METHODS
  
  C<PPI::Structure::Constructor> has no methods beyond those provided by
  the standard L<PPI::Structure>, L<PPI::Node> and L<PPI::Element> methods.
  
  Got any ideas for methods? Submit a report to rt.cpan.org!
  
  =cut
  
  use strict;
  use PPI::Structure ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Structure';
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_STRUCTURE_CONSTRUCTOR

$fatpacked{"PPI/Structure/For.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_STRUCTURE_FOR';
  package PPI::Structure::For;
  
  =pod
  
  =head1 NAME
  
  PPI::Structure::For - Circular braces for a for expression
  
  =head1 SYNOPSIS
  
    for ( var $i = 0; $i < $max; $i++ ) {
        ...
    }
  
  =head1 INHERITANCE
  
    PPI::Structure::For
    isa PPI::Structure
        isa PPI::Node
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  C<PPI::Structure::For> is the class used for circular braces that
  contain the three part C<for> expression.
  
  =head1 METHODS
  
  C<PPI::Structure::For> has no methods beyond those provided by the
  standard L<PPI::Structure>, L<PPI::Node> and L<PPI::Element> methods.
  
  Got any ideas for methods? Submit a report to rt.cpan.org!
  
  =cut
  
  use strict;
  use PPI::Structure ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Structure';
  }
  
  # Highly special custom isa method that will continue to respond
  # positively to ->isa('PPI::Structure::ForLoop') but warns.
  my $has_warned = 0;
  sub isa {
  	if ( $_[1] and $_[1] eq 'PPI::Structure::ForLoop' ) {
  		unless ( $has_warned ) {
  			warn("PPI::Structure::ForLoop has been deprecated");
  			$has_warned = 1;
  		}
  		return 1;
  	}
  	return shift->SUPER::isa(@_);
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_STRUCTURE_FOR

$fatpacked{"PPI/Structure/Given.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_STRUCTURE_GIVEN';
  package PPI::Structure::Given;
  
  =pod
  
  =head1 NAME
  
  PPI::Structure::Given - Circular braces for a switch statement
  
  =head1 SYNOPSIS
  
    given ( something ) {
        ...
    }
  
  =head1 INHERITANCE
  
    PPI::Structure::Given
    isa PPI::Structure
        isa PPI::Node
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  C<PPI::Structure::Given> is the class used for circular braces that
  contain the thing to be matched in a switch statement.
  
  =head1 METHODS
  
  C<PPI::Structure::Given> has no methods beyond those provided by the
  standard L<PPI::Structure>, L<PPI::Node> and L<PPI::Element> methods.
  
  Got any ideas for methods? Submit a report to rt.cpan.org!
  
  =cut
  
  use strict;
  use PPI::Structure ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Structure';
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_STRUCTURE_GIVEN

$fatpacked{"PPI/Structure/List.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_STRUCTURE_LIST';
  package PPI::Structure::List;
  
  =pod
  
  =head1 NAME
  
  PPI::Structure::List - Explicit list or precedence ordering braces
  
  =head1 SYNOPSIS
  
    # A list used for params
    function( 'param', 'param' );
    
    # Explicit list
    return ( 'foo', 'bar' );
  
  =head1 INHERITANCE
  
    PPI::Structure::List
    isa PPI::Structure
        isa PPI::Node
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  C<PPI::Structure::List> is the class used for circular braces that
  represent lists, and related.
  
  =head1 METHODS
  
  C<PPI::Structure::List> has no methods beyond those provided by the
  standard L<PPI::Structure>, L<PPI::Node> and L<PPI::Element> methods.
  
  Got any ideas for methods? Submit a report to rt.cpan.org!
  
  =cut
  
  use strict;
  use Carp           ();
  use PPI::Structure ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Structure';
  }
  
  # Highly special custom isa method that will continue to respond
  # positively to ->isa('PPI::Structure::ForLoop') but warns.
  my $has_warned = 0;
  sub isa {
  	if ( $_[1] and $_[1] eq 'PPI::Structure::ForLoop' ) {
  		if (
  			$_[0]->parent->isa('PPI::Statement::Compound')
  			and
  			$_[0]->parent->type =~ /^for/
  		) {
  			unless ( $has_warned ) {
  				local $Carp::CarpLevel = $Carp::CarpLevel + 1;
  				Carp::carp("PPI::Structure::ForLoop has been deprecated");
  				$has_warned = 1;
  			}
  			return 1;
  		}
  	}
  	return shift->SUPER::isa(@_);
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_STRUCTURE_LIST

$fatpacked{"PPI/Structure/Subscript.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_STRUCTURE_SUBSCRIPT';
  package PPI::Structure::Subscript;
  
  =pod
  
  =head1 NAME
  
  PPI::Structure::Subscript - Braces that represent an array or hash subscript
  
  =head1 SYNOPSIS
  
    # The end braces for all of the following are subscripts
    $foo->[...]
    $foo[...]
    $foo{...}[...]
    $foo->{...}
    $foo{...}
    $foo[]{...}
  
  =head1 INHERITANCE
  
    PPI::Structure::Subscript
    isa PPI::Structure
        isa PPI::Node
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  C<PPI::Structure::Subscript> is the class used for square and curly
  braces that specify one element of an array or hash (or a slice/subset
  of an array or hash)
  
  =head1 METHODS
  
  C<PPI::Structure::Subscript> has no methods beyond those provided by the
  standard L<PPI::Structure>, L<PPI::Node> and L<PPI::Element> methods.
  
  Got any ideas for methods? Submit a report to rt.cpan.org!
  
  =cut
  
  use strict;
  use PPI::Structure ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Structure';
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_STRUCTURE_SUBSCRIPT

$fatpacked{"PPI/Structure/Unknown.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_STRUCTURE_UNKNOWN';
  package PPI::Structure::Unknown;
  
  =pod
  
  =head1 NAME
  
  PPI::Structure::Unknown - An unknown or unresolved brace structure
  
  =head1 INHERITANCE
  
    PPI::Structure::Unknown
    isa PPI::Structure
        isa PPI::Node
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  C<PPI::Structure::Unknown> is class for braces whose type is unknown, or
  temporarily unknown.
  
  It primarily exists temporarily inside the lexer. Although some types of
  braces can be determined immediately at opening, there are a number of
  different brace types that can only be correctly identified after the
  braces are closed.
  
  A structure is typed as unknown during this period it is indeterminate.
  
  A C<PPI::Structure::Unknown> object should not B<ever> make it out of the
  lexer without being converted to it's final type. Any time you encounter
  this class in a PDOM tree it should be considered a bug and reported
  accordingly.
  
  =head1 METHODS
  
  C<PPI::Structure::Unknown> has no methods beyond those provided by the
  standard L<PPI::Structure>, L<PPI::Node> and L<PPI::Element> methods.
  
  Got any ideas for methods? Submit a report to rt.cpan.org!
  
  =cut
  
  use strict;
  use PPI::Structure ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Structure';
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_STRUCTURE_UNKNOWN

$fatpacked{"PPI/Structure/When.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_STRUCTURE_WHEN';
  package PPI::Structure::When;
  
  =pod
  
  =head1 NAME
  
  PPI::Structure::When - Circular braces for a when statement
  
  =head1 SYNOPSIS
  
    when ( something ) {
        ...
    }
  
  =head1 INHERITANCE
  
    PPI::Structure::When
    isa PPI::Structure
        isa PPI::Node
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  C<PPI::Structure::When> is the class used for circular braces that
  contain the thing to be matched in a when statement.
  
  =head1 METHODS
  
  C<PPI::Structure::When> has no methods beyond those provided by the
  standard L<PPI::Structure>, L<PPI::Node> and L<PPI::Element> methods.
  
  Got any ideas for methods? Submit a report to rt.cpan.org!
  
  =cut
  
  use strict;
  use PPI::Structure ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Structure';
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_STRUCTURE_WHEN

$fatpacked{"PPI/Token.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN';
  package PPI::Token;
  
  =pod
  
  =head1 NAME
  
  PPI::Token - A single token of Perl source code
  
  =head1 INHERITANCE
  
    PPI::Token
    isa PPI::Element
  
  =head1 DESCRIPTION
  
  C<PPI::Token> is the abstract base class for all Tokens. In PPI terms, a "Token" is
  a L<PPI::Element> that directly represents bytes of source code.
  
  =head1 METHODS
  
  =cut
  
  use strict;
  use Params::Util   qw{_INSTANCE};
  use PPI::Element   ();
  use PPI::Exception ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Element';
  }
  
  # We don't load the abstracts, they are loaded
  # as part of the inheritance process.
  
  # Load the token classes
  use PPI::Token::BOM                   ();
  use PPI::Token::Whitespace            ();
  use PPI::Token::Comment               ();
  use PPI::Token::Pod                   ();
  use PPI::Token::Number                ();
  use PPI::Token::Number::Binary        ();
  use PPI::Token::Number::Octal         ();
  use PPI::Token::Number::Hex           ();
  use PPI::Token::Number::Float         ();
  use PPI::Token::Number::Exp           ();
  use PPI::Token::Number::Version       ();
  use PPI::Token::Word                  ();
  use PPI::Token::DashedWord            ();
  use PPI::Token::Symbol                ();
  use PPI::Token::ArrayIndex            ();
  use PPI::Token::Magic                 ();
  use PPI::Token::Quote::Single         ();
  use PPI::Token::Quote::Double         ();
  use PPI::Token::Quote::Literal        ();
  use PPI::Token::Quote::Interpolate    ();
  use PPI::Token::QuoteLike::Backtick   ();
  use PPI::Token::QuoteLike::Command    ();
  use PPI::Token::QuoteLike::Regexp     ();
  use PPI::Token::QuoteLike::Words      ();
  use PPI::Token::QuoteLike::Readline   ();
  use PPI::Token::Regexp::Match         ();
  use PPI::Token::Regexp::Substitute    ();
  use PPI::Token::Regexp::Transliterate ();
  use PPI::Token::Operator              ();
  use PPI::Token::Cast                  ();
  use PPI::Token::Structure             ();
  use PPI::Token::Label                 ();
  use PPI::Token::HereDoc               ();
  use PPI::Token::Separator             ();
  use PPI::Token::Data                  ();
  use PPI::Token::End                   ();
  use PPI::Token::Prototype             ();
  use PPI::Token::Attribute             ();
  use PPI::Token::Unknown               ();
  
  
  
  
  
  #####################################################################
  # Constructor and Related
  
  sub new {
  	bless { content => (defined $_[1] ? "$_[1]" : '') }, $_[0];
  }
  
  sub set_class {
  	my $self  = shift;
  	# @_ or throw Exception("No arguments to set_class");
  	my $class = substr( $_[0], 0, 12 ) eq 'PPI::Token::' ? shift : 'PPI::Token::' . shift;
  
  	# Find out if the current and new classes are complex
  	my $old_quote = (ref($self) =~ /\b(?:Quote|Regex)\b/o) ? 1 : 0;
  	my $new_quote = ($class =~ /\b(?:Quote|Regex)\b/o)     ? 1 : 0;
  
  	# No matter what happens, we will have to rebless
  	bless $self, $class;
  
  	# If we are changing to or from a Quote style token, we
  	# can't just rebless and need to do some extra thing
  	# Otherwise, we have done enough
  	return $class if ($old_quote - $new_quote) == 0;
  
  	# Make a new token from the old content, and overwrite the current
  	# token's attributes with the new token's attributes.
  	my $token = $class->new( $self->{content} );
  	%$self = %$token;
  
  	# Return the class as a convenience
  	return $class;
  }
  
  
  
  
  
  #####################################################################
  # PPI::Token Methods
  
  =pod
  
  =head2 set_content $string
  
  The C<set_content> method allows to set/change the string that the
  C<PPI::Token> object represents.
  
  Returns the string you set the Token to
  
  =cut
  
  sub set_content {
  	$_[0]->{content} = $_[1];
  }
  
  =pod
  
  =head2 add_content $string
  
  The C<add_content> method allows you to add additional bytes of code
  to the end of the Token.
  
  Returns the new full string after the bytes have been added.
  
  =cut
  
  sub add_content { $_[0]->{content} .= $_[1] }
  
  =pod
  
  =head2 length
  
  The C<length> method returns the length of the string in a Token.
  
  =cut
  
  sub length { CORE::length($_[0]->{content}) }
  
  
  
  
  
  #####################################################################
  # Overloaded PPI::Element methods
  
  sub content {
  	$_[0]->{content};
  }
  
  # You can insert either a statement, or a non-significant token.
  sub insert_before {
  	my $self    = shift;
  	my $Element = _INSTANCE(shift, 'PPI::Element')  or return undef;
  	if ( $Element->isa('PPI::Structure') ) {
  		return $self->__insert_before($Element);
  	} elsif ( $Element->isa('PPI::Token') ) {
  		return $self->__insert_before($Element);
  	}
  	'';
  }
  
  # As above, you can insert a statement, or a non-significant token
  sub insert_after {
  	my $self    = shift;
  	my $Element = _INSTANCE(shift, 'PPI::Element') or return undef;
  	if ( $Element->isa('PPI::Structure') ) {
  		return $self->__insert_after($Element);
  	} elsif ( $Element->isa('PPI::Token') ) {
  		return $self->__insert_after($Element);
  	}
  	'';
  }
  
  
  
  
  
  #####################################################################
  # Tokenizer Methods
  
  sub __TOKENIZER__on_line_start { 1 }
  sub __TOKENIZER__on_line_end   { 1 }
  sub __TOKENIZER__on_char       { 'Unknown' }
  
  
  
  
  
  #####################################################################
  # Lexer Methods
  
  sub __LEXER__opens {
  	ref($_[0]) eq 'PPI::Token::Structure'
  	and
  	$_[0]->{content} =~ /(?:\(|\[|\{)/
  }
  
  sub __LEXER__closes {
  	ref($_[0]) eq 'PPI::Token::Structure'
  	and
  	$_[0]->{content} =~ /(?:\)|\]|\})/
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN

$fatpacked{"PPI/Token/ArrayIndex.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_ARRAYINDEX';
  package PPI::Token::ArrayIndex;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::ArrayIndex - Token getting the last index for an array
  
  =head1 INHERITANCE
  
    PPI::Token::ArrayIndex
    isa PPI::Token
        isa PPI::Element
  
  =head1 DESCRIPTION
  
  The C<PPI::Token::ArrayIndex> token represents an attempt to get the
  last index of an array, such as C<$#array>.
  
  =head1 METHODS
  
  There are no additional methods beyond those provided by the parent
  L<PPI::Token> and L<PPI::Element> classes.
  
  Got any ideas for methods? Submit a report to rt.cpan.org!
  
  =cut
  
  use strict;
  use PPI::Token ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Token';
  }
  
  
  
  
  
  #####################################################################
  # Tokenizer Methods
  
  sub __TOKENIZER__on_char {
  	my $t = $_[1];
  
  	# Suck in till the end of the arrayindex
  	my $line = substr( $t->{line}, $t->{line_cursor} );
  	if ( $line =~ /^([\w:']+)/ ) {
  		$t->{token}->{content} .= $1;
  		$t->{line_cursor} += length $1;
  	}
  
  	# End of token
  	$t->_finalize_token->__TOKENIZER__on_char( $t );
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_ARRAYINDEX

$fatpacked{"PPI/Token/Attribute.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_ATTRIBUTE';
  package PPI::Token::Attribute;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::Attribute - A token for a subroutine attribute
  
  =head1 INHERITANCE
  
    PPI::Token::Attribute
    isa PPI::Token
        isa PPI::Element
  
  =head1 DESCRIPTION
  
  In Perl, attributes are a relatively recent addition to the language.
  
  Given the code C< sub foo : bar(something) {} >, the C<bar(something)>
  part is the attribute.
  
  A C<PPI::Token::Attribute> token represents the entire of the attribute,
  as the braces and its contents are not parsed into the tree, and are
  treated by Perl (and thus by us) as a single string.
  
  =head1 METHODS
  
  This class provides some additional methods beyond those provided by its
  L<PPI::Token> and L<PPI::Element> parent classes.
  
  Got any ideas for methods? Submit a report to rt.cpan.org!
  
  =cut
  
  use strict;
  use PPI::Token ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Token';
  }
  
  
  
  
  #####################################################################
  # PPI::Token::Attribute Methods
  
  =pod
  
  =head2 identifier
  
  The C<identifier> attribute returns the identifier part of the attribute.
  
  That is, for the attribute C<foo(bar)>, the C<identifier> method would
  return C<"foo">.
  
  =cut
  
  sub identifier {
  	my $self = shift;
  	$self->{content} =~ /^(.+?)\(/ ? $1 : $self->{content};
  }
  
  =pod
  
  =head2 parameters
  
  The C<parameters> method returns the parameter strong for the attribute.
  
  That is, for the attribute C<foo(bar)>, the C<parameters> method would
  return C<"bar">.
  
  Returns the parameters as a string (including the null string C<''> for
  the case of an attribute such as C<foo()>.
  
  Returns C<undef> if the attribute does not have parameters.
  
  =cut
  
  sub parameters {
  	my $self = shift;
  	$self->{content} =~ /\((.+)\)$/ ? $1 : undef;
  }
  
  
  
  
  
  #####################################################################
  # Tokenizer Methods
  
  sub __TOKENIZER__on_char {
  	my $class = shift;
  	my $t     = shift;
  	my $char  = substr( $t->{line}, $t->{line_cursor}, 1 );
  
  	# Unless this is a '(', we are finished.
  	unless ( $char eq '(' ) {
  		# Finalise and recheck
  		return $t->_finalize_token->__TOKENIZER__on_char( $t );
  	}
  
  	# This is a bar(...) style attribute.
  	# We are currently on the ( so scan in until the end.
  	# We finish on the character AFTER our end
  	my $string = $class->__TOKENIZER__scan_for_end( $t );
  	if ( ref $string ) {
  		# EOF
  		$t->{token}->{content} .= $$string;
  		$t->_finalize_token;
  		return 0;
  	}
  
  	# Found the end of the attribute
  	$t->{token}->{content} .= $string;
  	$t->_finalize_token->__TOKENIZER__on_char( $t );
  }
  
  # Scan for a close braced, and take into account both escaping,
  # and open close bracket pairs in the string. When complete, the
  # method leaves the line cursor on the LAST character found.
  sub __TOKENIZER__scan_for_end {
  	my $t = $_[1];
  
  	# Loop as long as we can get new lines
  	my $string = '';
  	my $depth = 0;
  	while ( exists $t->{line} ) {
  		# Get the search area
  		my $search = $t->{line_cursor}
  			? substr( $t->{line}, $t->{line_cursor} )
  			: $t->{line};
  
  		# Look for a match
  		unless ( $search =~ /^((?:\\.|[^()])*?[()])/ ) {
  			# Load in the next line and push to first character
  			$string .= $search;
  			$t->_fill_line(1) or return \$string;
  			$t->{line_cursor} = 0;
  			next;
  		}
  
  		# Add to the string
  		$string .= $1;
  		$t->{line_cursor} += length $1;
  
  		# Alter the depth and continue if we arn't at the end
  		$depth += ($1 =~ /\($/) ? 1 : -1 and next;
  
  		# Found the end
  		return $string;
  	}
  
  	# Returning the string as a reference indicates EOF
  	\$string;
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_ATTRIBUTE

$fatpacked{"PPI/Token/BOM.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_BOM';
  package PPI::Token::BOM;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::BOM - Tokens representing Unicode byte order marks
  
  =head1 INHERITANCE
  
    PPI::Token::BOM
    isa PPI::Token
        isa PPI::Element
  
  =head1 DESCRIPTION
  
  This is a special token in that it can only occur at the beginning of
  documents.  If a BOM byte mark occurs elsewhere in a file, it should
  be treated as L<PPI::Token::Whitespace>.  We recognize the byte order
  marks identified at this URL:
  L<http://www.unicode.org/faq/utf_bom.html#BOM>
  
      UTF-32, big-endian     00 00 FE FF
      UTF-32, little-endian  FF FE 00 00
      UTF-16, big-endian     FE FF
      UTF-16, little-endian  FF FE
      UTF-8                  EF BB BF
  
  Note that as of this writing, PPI only has support for UTF-8
  (namely, in POD and strings) and no support for UTF-16 or UTF-32.  We
  support the BOMs of the latter two for completeness only.
  
  The BOM is considered non-significant, like white space.
  
  =head1 METHODS
  
  There are no additional methods beyond those provided by the parent
  L<PPI::Token> and L<PPI::Element> classes.
  
  =cut
  
  use strict;
  use PPI::Token ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Token';
  }
  
  sub significant { '' }
  
  
  
  
  
  #####################################################################
  # Parsing Methods
  
  my %bom_types = (
     "\x00\x00\xfe\xff" => 'UTF-32',
     "\xff\xfe\x00\x00" => 'UTF-32',
     "\xfe\xff"         => 'UTF-16',
     "\xff\xfe"         => 'UTF-16',
     "\xef\xbb\xbf"     => 'UTF-8',
  );
  
  sub __TOKENIZER__on_line_start {
  	my $t = $_[1];
  	$_ = $t->{line};
  
  	if (m/^(\x00\x00\xfe\xff |  # UTF-32, big-endian
  		\xff\xfe\x00\x00 |  # UTF-32, little-endian
  		\xfe\xff         |  # UTF-16, big-endian
  		\xff\xfe         |  # UTF-16, little-endian
  		\xef\xbb\xbf)       # UTF-8
  	    /xs) {
  	   my $bom = $1;
  
  	   if ($bom_types{$bom} ne 'UTF-8') {
  	      return $t->_error("$bom_types{$bom} is not supported");
  	   }
  
  	   $t->_new_token('BOM', $bom) or return undef;
  	   $t->{line_cursor} += length $bom;
  	}
  
  	# Continue just as if there was no BOM
  	$t->{class} = 'PPI::Token::Whitespace';
  	return $t->{class}->__TOKENIZER__on_line_start($t);
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module
  
  =head1 AUTHOR
  
  Chris Dolan E<lt>cdolan@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_BOM

$fatpacked{"PPI/Token/Cast.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_CAST';
  package PPI::Token::Cast;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::Cast - A prefix which forces a value into a different context
  
  =head1 INHERITANCE
  
    PPI::Token::Cast
    isa PPI::Token
        isa PPI::Element
  
  =head1 DESCRIPTION
  
  A "cast" in PPI terms is one of more characters used as a prefix which force
  a value into a different class or context.
  
  This includes referencing, dereferencing, and a few other minor cases.
  
  For expressions such as C<@$foo> or C<@{ $foo{bar} }> the C<@> in both cases
  represents a cast. In this case, an array dereference.
  
  =head1 METHODS
  
  There are no additional methods beyond those provided by the parent
  L<PPI::Token> and L<PPI::Element> classes.
  
  Got any ideas for methods? Submit a report to rt.cpan.org!
  
  =cut
  
  use strict;
  use PPI::Token ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Token';
  }
  
  
  
  
  #####################################################################
  # Tokenizer Methods
  
  # A cast is either % @ $ or $#
  sub __TOKENIZER__on_char {
  	$_[1]->_finalize_token->__TOKENIZER__on_char( $_[1] );
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_CAST

$fatpacked{"PPI/Token/Comment.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_COMMENT';
  package PPI::Token::Comment;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::Comment - A comment in Perl source code
  
  =head1 INHERITANCE
  
    PPI::Token::Comment
    isa PPI::Token
        isa PPI::Element
  
  =head1 SYNOPSIS
  
    # This is a PPI::Token::Comment
    
    print "Hello World!"; # So it this
    
    $string =~ s/ foo  # This, unfortunately, is not :(
          bar
    	/w;
  
  =head1 DESCRIPTION
  
  In PPI, comments are represented by C<PPI::Token::Comment> objects.
  
  These come in two flavours, line comment and inline comments.
  
  A C<line comment> is a comment that stands on its own line. These comments
  hold their own newline and whitespace (both leading and trailing) as part
  of the one C<PPI::Token::Comment> object.
  
  An inline comment is a comment that appears after some code, and
  continues to the end of the line. This does B<not> include whitespace,
  and the terminating newlines is considered a separate
  L<PPI::Token::Whitespace> token.
  
  This is largely a convenience, simplifying a lot of normal code relating
  to the common things people do with comments.
  
  Most commonly, it means when you C<prune> or C<delete> a comment, a line
  comment disappears taking the entire line with it, and an inline comment
  is removed from the inside of the line, allowing the newline to drop
  back onto the end of the code, as you would expect.
  
  It also means you can move comments around in blocks much more easily.
  
  For now, this is a suitably handy way to do things. However, I do reserve
  the right to change my mind on this one if it gets dangerously
  anachronistic somewhere down the line.
  
  =head1 METHODS
  
  Only very limited methods are available, beyond those provided by our
  parent L<PPI::Token> and L<PPI::Element> classes.
  
  =cut
  
  use strict;
  use PPI::Token ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Token';
  }
  
  ### XS -> PPI/XS.xs:_PPI_Token_Comment__significant 0.900+
  sub significant { '' }
  
  # Most stuff goes through __TOKENIZER__commit.
  # This is such a rare case, do char at a time to keep the code small
  sub __TOKENIZER__on_char {
  	my $t = $_[1];
  
  	# Make sure not to include the trailing newline
  	if ( substr( $t->{line}, $t->{line_cursor}, 1 ) eq "\n" ) {
  		return $t->_finalize_token->__TOKENIZER__on_char( $t );
  	}
  
  	1;
  }
  
  sub __TOKENIZER__commit {
  	my $t = $_[1];
  
  	# Get the rest of the line
  	my $rest = substr( $t->{line}, $t->{line_cursor} );
  	if ( chomp $rest ) { # Include the newline separately
  		# Add the current token, and the newline
  		$t->_new_token('Comment', $rest);
  		$t->_new_token('Whitespace', "\n");
  	} else {
  		# Add this token only
  		$t->_new_token('Comment', $rest);
  	}
  
  	# Advance the line cursor to the end
  	$t->{line_cursor} = $t->{line_length} - 1;
  
  	0;
  }
  
  # Comments end at the end of the line
  sub __TOKENIZER__on_line_end {
  	$_[1]->_finalize_token if $_[1]->{token};
  	1;
  }
  
  =pod
  
  =head2 line
  
  The C<line> accessor returns true if the C<PPI::Token::Comment> is a
  line comment, or false if it is an inline comment.
  
  =cut
  
  sub line {
  	# Entire line comments have a newline at the end
  	$_[0]->{content} =~ /\n$/ ? 1 : 0;
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_COMMENT

$fatpacked{"PPI/Token/DashedWord.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_DASHEDWORD';
  package PPI::Token::DashedWord;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::DashedWord - A dashed bareword token
  
  =head1 INHERITANCE
  
    PPI::Token::DashedWord
    isa PPI::Token
        isa PPI::Element
  
  =head1 DESCRIPTION
  
  The "dashed bareword" token represents literal values like C<-foo>.
  
  NOTE: this class is currently unused.  All tokens that should be
  PPI::Token::DashedWords are just normal PPI::Token::Word instead.
  That actually makes sense, since there really is nothing special about
  this class except that dashed words cannot be subroutine names or
  keywords.  As such, this class may be removed from PPI in the future.
  
  =head1 METHODS
  
  =cut
  
  use strict;
  use PPI::Token ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Token';
  }
  
  =pod
  
  =head2 literal
  
  Returns the value of the dashed word as a string.  This differs from
  C<content> because C<-Foo'Bar> expands to C<-Foo::Bar>.
  
  =begin testing literal 9
  
  my @pairs = (
  	"-foo",        '-foo',
  	"-Foo::Bar",   '-Foo::Bar',
  	"-Foo'Bar",    '-Foo::Bar',
  );
  while ( @pairs ) {
  	my $from  = shift @pairs;
  	my $to    = shift @pairs;
  	my $doc   = PPI::Document->new( \"( $from => 1 );" );
  	isa_ok( $doc, 'PPI::Document' );
  	my $word = $doc->find_first('Token::DashedWord');
  	SKIP: {
  		skip( "PPI::Token::DashedWord is deactivated", 2 );
  		isa_ok( $word, 'PPI::Token::DashedWord' );
  		is( $word && $word->literal, $to, "The source $from becomes $to ok" );
  	}
  }
  
  =end testing
  
  =cut
  
  *literal = *PPI::Token::Word::literal;
  
  
  
  #####################################################################
  # Tokenizer Methods
  
  sub __TOKENIZER__on_char {
  	my $t = $_[1];
  
  	# Suck to the end of the dashed bareword
  	my $line = substr( $t->{line}, $t->{line_cursor} );
  	if ( $line =~ /^(\w+)/ ) {
  		$t->{token}->{content} .= $1;
  		$t->{line_cursor} += length $1;
  	}
  
  	# Are we a file test operator?
  	if ( $t->{token}->{content} =~ /^\-[rwxoRWXOezsfdlpSbctugkTBMAC]$/ ) {
  		# File test operator
  		$t->{class} = $t->{token}->set_class( 'Operator' );
  	} else {
  		# No, normal dashed bareword
  		$t->{class} = $t->{token}->set_class( 'Word' );
  	}
  
  	$t->_finalize_token->__TOKENIZER__on_char( $t );
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_DASHEDWORD

$fatpacked{"PPI/Token/Data.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_DATA';
  package PPI::Token::Data;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::Data - The actual data in the __DATA__ section of a file
  
  =head1 INHERITANCE
  
    PPI::Token::Data
    isa PPI::Token
        isa PPI::Element
  
  =head1 DESCRIPTION
  
  The C<PPI::Token::Data> class is used to represent the actual data inside
  a file's C<__DATA__> section.
  
  One C<PPI::Token::Data> object is used to represent the entire of the data,
  primarily so that it can provide a convenient handle directly to the data.
  
  =head1 METHODS
  
  C<PPI::Token::Data> provides one method in addition to those provided by
  our parent L<PPI::Token> and L<PPI::Element> classes.
  
  =cut
  
  use strict;
  use IO::String ();
  use PPI::Token ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Token';
  }
  
  
  
  
  
  #####################################################################
  # Methods
  
  =pod
  
  =head2 handle
  
  The C<handle> method returns a L<IO::String> handle that allows you
  to do all the normal handle-y things to the contents of the __DATA__
  section of the file.
  
  Unlike in perl itself, this means you can also do things like C<print>
  new data onto the end of the __DATA__ section, or modify it with
  any other process that can accept an L<IO::Handle> as input or output.
  
  Returns an L<IO::String> object.
  
  =cut
  
  sub handle {
  	my $self = shift;
  	IO::String->new( \$self->{content} );
  }
  
  sub __TOKENIZER__on_char { 1 }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_DATA

$fatpacked{"PPI/Token/End.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_END';
  package PPI::Token::End;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::End - Completely useless content after the __END__ tag
  
  =head1 INHERITANCE
  
    PPI::Token::End
    isa PPI::Token
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  If you've read L<PPI::Token::Whitespace>, you should understand by now
  the concept of documents "floating in a sea of PPI::Token::Whitespace".
  
  Well it doesn't after the __END__ tag.
  
  Once you __END__, it's all over. Anything after that tag isn't even fit
  to be called whitespace. It just simply doesn't exist as far as perl
  (the interpreter) is concerned.
  
  That's not to say there isn't useful content. Most often people use
  the __END__ tag to hide POD content, so that perl never has to see it,
  and presumably providing some small speed up.
  
  That's fine. PPI likes POD. Any POD after the __END__ tag is parsed
  into valid L<PPI::Token::Pod> tags as normal. B<This> class, on the
  other hand, is for "what's after __END__ when it isn't POD". 
  
  Basically, the completely worthless bits of the file :)
  
  =head1 METHODS
  
  This class has no method beyond what is provided by its L<PPI::Token> and
  L<PPI::Element> parent classes.
  
  =cut
  
  use strict;
  use PPI::Token ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Token';
  }
  
  
  
  
  
  #####################################################################
  # Tokenizer Methods
  
  ### XS -> PPI/XS.xs:_PPI_Token_End__significant 0.900+
  sub significant { '' }
  
  sub __TOKENIZER__on_char { 1 }
  
  sub __TOKENIZER__on_line_start {
  	my $t = $_[1];
  
  	# Can we classify the entire line in one go
  	if ( $t->{line} =~ /^=(\w+)/ ) {
  		# A Pod tag... change to pod mode
  		$t->_new_token( 'Pod', $t->{line} );
  		unless ( $1 eq 'cut' ) {
  			# Normal start to pod
  			$t->{class} = 'PPI::Token::Pod';
  		}
  
  		# This is an error, but one we'll ignore
  		# Don't go into Pod mode, since =cut normally
  		# signals the end of Pod mode
  	} else {
  		if ( defined $t->{token} ) {
  			# Add to existing token
  			$t->{token}->{content} .= $t->{line};
  		} else {
  			$t->_new_token( 'End', $t->{line} );
  		}
  	}
  
  	0;
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_END

$fatpacked{"PPI/Token/HereDoc.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_HEREDOC';
  package PPI::Token::HereDoc;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::HereDoc - Token class for the here-doc
  
  =head1 INHERITANCE
  
    PPI::Token::HereDoc
    isa PPI::Token
        isa PPI::Element
  
  =head1 DESCRIPTION
  
  Here-docs are incredibly handy when writing Perl, but incredibly tricky
  when parsing it, primarily because they don't follow the general flow of
  input.
  
  They jump ahead and nab lines directly off the input buffer. Whitespace
  and newlines may not matter in most Perl code, but they matter in here-docs.
  
  They are also tricky to store as an object. They look sort of like an
  operator and a string, but they don't act like it. And they have a second
  section that should be something like a separate token, but isn't because a
  strong can span from above the here-doc content to below it.
  
  So when parsing, this is what we do.
  
  Firstly, the PPI::Token::HereDoc object, does not represent the C<<< << >>>
  operator, or the "END_FLAG", or the content, or even the terminator.
  
  It represents all of them at once.
  
  The token itself has only the declaration part as its "content".
  
    # This is what the content of a HereDoc token is
    <<FOO
    
    # Or this
    <<"FOO"
    
    # Or even this
    <<      'FOO'
  
  That is, the "operator", any whitespace separator, and the quoted or bare
  terminator. So when you call the C<content> method on a HereDoc token, you
  get '<< "FOO"'.
  
  As for the content and the terminator, when treated purely in "content" terms
  they do not exist.
  
  The content is made available with the C<heredoc> method, and the name of
  the terminator with the C<terminator> method.
  
  To make things work in the way you expect, PPI has to play some games
  when doing line/column location calculation for tokens, and also during
  the content parsing and generation processes.
  
  Documents cannot simply by recreated by stitching together the token
  contents, and involve a somewhat more expensive procedure, but the extra
  expense should be relatively negligible unless you are doing huge
  quantities of them.
  
  Please note that due to the immature nature of PPI in general, we expect
  C<HereDocs> to be a rich (bad) source of corner-case bugs for quite a while,
  but for the most part they should more or less DWYM.
  
  =head2 Comparison to other string types
  
  Although technically it can be considered a quote, for the time being
  C<HereDocs> are being treated as a completely separate C<Token> subclass,
  and will not be found in a search for L<PPI::Token::Quote> or
  L<PPI::Token::QuoteLike objects>.
  
  This may change in the future, with it most likely to end up under
  QuoteLike.
  
  =head1 METHODS
  
  Although it has the standard set of C<Token> methods, C<HereDoc> objects
  have a relatively large number of unique methods all of their own.
  
  =cut
  
  use strict;
  use PPI::Token ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Token';
  }
  
  
  
  
  
  #####################################################################
  # PPI::Token::HereDoc Methods
  
  =pod
  
  =head2 heredoc
  
  The C<heredoc> method is the authoritative method for accessing the contents
  of the C<HereDoc> object.
  
  It returns the contents of the here-doc as a list of newline-terminated
  strings. If called in scalar context, it returns the number of lines in
  the here-doc, B<excluding> the terminator line.
  
  =cut
  
  sub heredoc {
  	wantarray
  		? @{shift->{_heredoc}}
  		: scalar @{shift->{_heredoc}};
  }
  
  =pod
  
  =head2 terminator
  
  The C<terminator> method returns the name of the terminating string for the
  here-doc.
  
  Returns the terminating string as an unescaped string (in the rare case
  the terminator has an escaped quote in it).
  
  =cut
  
  sub terminator {
  	shift->{_terminator};
  }
  
  
  
  
  
  #####################################################################
  # Tokenizer Methods
  
  # Parse in the entire here-doc in one call
  sub __TOKENIZER__on_char {
  	my $t     = $_[1];
  
  	# We are currently located on the first char after the <<
  
  	# Handle the most common form first for simplicity and speed reasons
  	### FIXME - This regex, and this method in general, do not yet allow
  	### for the null here-doc, which terminates at the first
  	### empty line.
  	my $rest_of_line = substr( $t->{line}, $t->{line_cursor} );
  	unless ( $rest_of_line =~ /^( \s* (?: "[^"]*" | '[^']*' | `[^`]*` | \\?\w+ ) )/x  ) {
  		# Degenerate to a left-shift operation
  		$t->{token}->set_class('Operator');
  		return $t->_finalize_token->__TOKENIZER__on_char( $t );
  	}
  
  	# Add the rest of the token, work out what type it is,
  	# and suck in the content until the end.
  	my $token = $t->{token};
  	$token->{content} .= $1;
  	$t->{line_cursor} += length $1;
  
  	# Find the terminator, clean it up and determine
  	# the type of here-doc we are dealing with.
  	my $content = $token->{content};
  	if ( $content =~ /^\<\<(\w+)$/ ) {
  		# Bareword
  		$token->{_mode}       = 'interpolate';
  		$token->{_terminator} = $1;
  
  	} elsif ( $content =~ /^\<\<\s*\'(.*)\'$/ ) {
  		# ''-quoted literal
  		$token->{_mode}       = 'literal';
  		$token->{_terminator} = $1;
  		$token->{_terminator} =~ s/\\'/'/g;
  
  	} elsif ( $content =~ /^\<\<\s*\"(.*)\"$/ ) {
  		# ""-quoted literal
  		$token->{_mode}       = 'interpolate';
  		$token->{_terminator} = $1;
  		$token->{_terminator} =~ s/\\"/"/g;
  
  	} elsif ( $content =~ /^\<\<\s*\`(.*)\`$/ ) {
  		# ``-quoted command
  		$token->{_mode}       = 'command';
  		$token->{_terminator} = $1;
  		$token->{_terminator} =~ s/\\`/`/g;
  
  	} elsif ( $content =~ /^\<\<\\(\w+)$/ ) {
  		# Legacy forward-slashed bareword
  		$token->{_mode}       = 'literal';
  		$token->{_terminator} = $1;
  
  	} else {
  		# WTF?
  		return undef;
  	}
  
  	# Define $line outside of the loop, so that if we encounter the
  	# end of the file, we have access to the last line still.
  	my $line;
  
  	# Suck in the HEREDOC
  	$token->{_heredoc} = [];
  	my $terminator = $token->{_terminator} . "\n";
  	while ( defined($line = $t->_get_line) ) {
  		if ( $line eq $terminator ) {
  			# Keep the actual termination line for consistency
  			# when we are re-assembling the file
  			$token->{_terminator_line} = $line;
  
  			# The HereDoc is now fully parsed
  			return $t->_finalize_token->__TOKENIZER__on_char( $t );
  		}
  
  		# Add the line
  		push @{$token->{_heredoc}}, $line;
  	}
  
  	# End of file.
  	# Error: Didn't reach end of here-doc before end of file.
  	# $line might be undef if we get NO lines.
  	if ( defined $line and $line eq $token->{_terminator} ) {
  		# If the last line matches the terminator
  		# but is missing the newline, we want to allow
  		# it anyway (like perl itself does). In this case
  		# perl would normally throw a warning, but we will
  		# also ignore that as well.
  		pop @{$token->{_heredoc}};
  		$token->{_terminator_line} = $line;
  	} else {
  		# The HereDoc was not properly terminated.
  		$token->{_terminator_line} = undef;
  
  		# Trim off the trailing whitespace
  		if ( defined $token->{_heredoc}->[-1] and $t->{source_eof_chop} ) {
  			chop $token->{_heredoc}->[-1];
  			$t->{source_eof_chop} = '';
  		}
  	}
  
  	# Set a hint for PPI::Document->serialize so it can
  	# inexpensively repair it if needed when writing back out.
  	$token->{_damaged} = 1;
  
  	# The HereDoc is not fully parsed
  	$t->_finalize_token->__TOKENIZER__on_char( $t );
  }
  
  1;
  
  =pod
  
  =head1 TO DO
  
  - Implement PPI::Token::Quote interface compatibility
  
  - Check CPAN for any use of the null here-doc or here-doc-in-s///e
  
  - Add support for the null here-doc
  
  - Add support for here-doc in s///e
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_HEREDOC

$fatpacked{"PPI/Token/Label.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_LABEL';
  package PPI::Token::Label;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::Label - Token class for a statement label
  
  =head1 INHERITANCE
  
    PPI::Token::Label
    isa PPI::Token
        isa PPI::Element
  
  =head1 DESCRIPTION
  
  A label is an identifier attached to a line or statements, to allow for
  various types of flow control. For example, a loop might have a label
  attached so that a C<last> or C<next> flow control statement can be used
  from multiple levels below to reference the loop directly.
  
  =head1 METHODS
  
  There are no additional methods beyond those provided by the parent
  L<PPI::Token> and L<PPI::Element> classes.
  
  Got any ideas for methods? Submit a report to rt.cpan.org!
  
  =cut
  
  use strict;
  use PPI::Token ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Token';
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_LABEL

$fatpacked{"PPI/Token/Magic.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_MAGIC';
  package PPI::Token::Magic;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::Magic - Tokens representing magic variables
  
  =head1 INHERITANCE
  
    PPI::Token::Magic
    isa PPI::Token::Symbol
        isa PPI::Token
            isa PPI::Element
  
  =head1 SYNOPSIS
  
    # When we say magic variables, we mean these...
    $1   $2   $3   $4   $5   $6   $7   $8   $9
    $_   $&   $`   $'   $+   @+   %+   $*   $.    $/    $|
    $\\  $"   $;   $%   $=   $-   @-   %-   $)    $#
    $~   $^   $:   $?   $!   %!   $@   $$   $<    $>
    $(   $0   $[   $]   @_   @*   $}   $,   $#+   $#-
    $^L  $^A  $^E  $^C  $^D  $^F  $^H
    $^I  $^M  $^N  $^O  $^P  $^R  $^S
    $^T  $^V  $^W  $^X
  
  =head1 DESCRIPTION
  
  C<PPI::Token::Magic> is a sub-class of L<PPI::Token::Symbol> which
  identifies the token as "magic variable", one of the strange and
  unusual variables that are connected to "things" behind the scenes.
  
  Some are extremely common, like C<$_>, and others you will quite
  probably never encounter in your Perl career.
  
  =head1 METHODS
  
  The class provides no additional methods, beyond those provided by it's
  L<PPI::Token::Symbol>, L<PPI::Token> and L<PPI::Element>.
  
  =cut
  
  use strict;
  use PPI::Token::Symbol ();
  use PPI::Token::Unknown ();
  
  use vars qw{$VERSION @ISA %magic};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Token::Symbol';
  
  	# Magic variables taken from perlvar.
  	# Several things added separately to avoid warnings.
  	foreach ( qw{
  		$1 $2 $3 $4 $5 $6 $7 $8 $9
  		$_ $& $` $' $+ @+ %+ $* $. $/ $|
  		$\\ $" $; $% $= $- @- %- $)
  		$~ $^ $: $? $! %! $@ $$ $< $>
  		$( $0 $[ $] @_ @*
  
  		$^L $^A $^E $^C $^D $^F $^H
  		$^I $^M $^N $^O $^P $^R $^S
  		$^T $^V $^W $^X %^H
  
  		$::|
  	}, '$}', '$,', '$#', '$#+', '$#-' ) {
  		$magic{$_} = 1;
  	}
  }
  
  =pod
  
  =begin testing __TOKENIZER_on_char 30
  
  my $document = PPI::Document->new(\<<'END_PERL');
  $[;			# Magic  $[
  $$;			# Magic  $$
  %-;			# Magic  %-
  $#-;			# Magic  $#-
  $$foo;			# Symbol $foo		Dereference of $foo
  $^W;			# Magic  $^W
  $^WIDE_SYSTEM_CALLS;	# Magic  $^WIDE_SYSTEM_CALLS
  ${^MATCH};		# Magic  ${^MATCH}
  @{^_Bar};		# Magic  @{^_Bar}
  ${^_Bar}[0];		# Magic  @{^_Bar}
  %{^_Baz};		# Magic  %{^_Baz}
  ${^_Baz}{burfle};	# Magic  %{^_Baz}
  $${^MATCH};		# Magic  ${^MATCH}	Dereference of ${^MATCH}
  \${^MATCH};		# Magic  ${^MATCH}
  END_PERL
  
  isa_ok( $document, 'PPI::Document' );
  
  $document->index_locations();
  
  my $symbols = $document->find( 'PPI::Token::Symbol' );
  
  is( scalar(@$symbols), 14, 'Found 14 symbols' );
  my $comments = $document->find( 'PPI::Token::Comment' );
  
  foreach my $token ( @$symbols ) {
  	my ($hash, $class, $name, $remk) =
  		split '\s+', $comments->[$token->line_number - 1], 4;
  	isa_ok( $token, "PPI::Token::$class" );
  	is( $token->symbol, $name, $remk || "The symbol is $name" );
  }
  
  =end testing
  
  =cut
  
  sub __TOKENIZER__on_char {
  	my $t = $_[1];
  
  	# $c is the candidate new content
  	my $c = $t->{token}->{content} . substr( $t->{line}, $t->{line_cursor}, 1 );
  
  	# Do a quick first test so we don't have to do more than this one.
  	# All of the tests below match this one, so it should provide a
  	# small speed up. This regex should be updated to match the inside
  	# tests if they are changed.
  	if ( $c =~ /^  \$  .*  [  \w  :  \$  \{  ]  $/x ) {
  
  		if ( $c =~ /^(\$(?:\_[\w:]|::))/ or $c =~ /^\$\'[\w]/ ) {
  			# If and only if we have $'\d, it is not a
  			# symbol. (this was apparently a concious choice)
  			# Note that $::0 on the other hand is legal
  			if ( $c =~ /^\$\'\d$/ ) {
  				# In this case, we have a magic plus a digit.
  				# Save the CURRENT token, and rerun the on_char
  				return $t->_finalize_token->__TOKENIZER__on_char( $t );
  			}
  
  			# A symbol in the style $_foo or $::foo or $'foo.
  			# Overwrite the current token
  			$t->{class} = $t->{token}->set_class('Symbol');
  			return PPI::Token::Symbol->__TOKENIZER__on_char( $t );
  		}
  
  		if ( $c =~ /^\$\$\w/ ) {
  			# This is really a scalar dereference. ( $$foo )
  			# Add the current token as the cast...
  			$t->{token} = PPI::Token::Cast->new( '$' );
  			$t->_finalize_token;
  
  			# ... and create a new token for the symbol
  			return $t->_new_token( 'Symbol', '$' );
  		}
  
  		if ( $c eq '$${' ) {
  			# This _might_ be a dereference of one of the
  			# control-character symbols.
  			my $line = substr $t->{line}, $t->{line_cursor} + 1;
  			if ( $line =~ m/$PPI::Token::Unknown::CURLY_SYMBOL/ ) {
  				# This is really a dereference. ( $${^_foo} )
  				# Add the current token as the cast...
  				$t->{token} = PPI::Token::Cast->new( '$' );
  				$t->_finalize_token;
  
  				# ... and create a new token for the symbol
  				return $t->_new_token( 'Magic', '$' );
  			}
  		}
  
  		if ( $c eq '$#$' or $c eq '$#{' ) {
  			# This is really an index dereferencing cast, although
  			# it has the same two chars as the magic variable $#.
  			$t->{class} = $t->{token}->set_class('Cast');
  			return $t->_finalize_token->__TOKENIZER__on_char( $t );
  		}
  
  		if ( $c =~ /^(\$\#)\w/ ) {
  			# This is really an array index thingy ( $#array )
  			$t->{token} = PPI::Token::ArrayIndex->new( "$1" );
  			return PPI::Token::ArrayIndex->__TOKENIZER__on_char( $t );
  		}
  
  		if ( $c =~ /^\$\^\w+$/o ) {
  			# It's an escaped char magic... maybe ( like $^M )
  			my $next = substr( $t->{line}, $t->{line_cursor}+1, 1 ); # Peek ahead
  			if ($magic{$c} && (!$next || $next !~ /\w/)) {
  				$t->{token}->{content} = $c;
  				$t->{line_cursor}++;
  			} else {
  				# Maybe it's a long magic variable like $^WIDE_SYSTEM_CALLS
  				return 1;
  			}
  		}
  
  		if ( $c =~ /^\$\#\{/ ) {
  			# The $# is actually a case, and { is its block
  			# Add the current token as the cast...
  			$t->{token} = PPI::Token::Cast->new( '$#' );
  			$t->_finalize_token;
  
  			# ... and create a new token for the block
  			return $t->_new_token( 'Structure', '{' );
  		}
  	} elsif ($c =~ /^%\^/) {
  		return 1 if $c eq '%^';
  		# It's an escaped char magic... maybe ( like %^H )
  		if ($magic{$c}) {
  			$t->{token}->{content} = $c;
  			$t->{line_cursor}++;
  		} else {
  			# Back off, treat '%' as an operator
  			chop $t->{token}->{content};
  			bless $t->{token}, $t->{class} = 'PPI::Token::Operator';
  			$t->{line_cursor}--;
  		}
  	}
  
  	if ( $magic{$c} ) {
  		# $#+ and $#-
  		$t->{line_cursor} += length( $c ) - length( $t->{token}->{content} );
  		$t->{token}->{content} = $c;
  	} else {
  		my $line = substr( $t->{line}, $t->{line_cursor} );
  		if ( $line =~ /($PPI::Token::Unknown::CURLY_SYMBOL)/ ) {
  			# control character symbol (e.g. ${^MATCH})
  			$t->{token}->{content} .= $1;
  			$t->{line_cursor}      += length $1;
  		}
  	}
  
  	# End the current magic token, and recheck
  	$t->_finalize_token->__TOKENIZER__on_char( $t );
  }
  
  # Our version of canonical is plain simple
  sub canonical { $_[0]->content }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_MAGIC

$fatpacked{"PPI/Token/Number.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_NUMBER';
  package PPI::Token::Number;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::Number - Token class for a number
  
  =head1 SYNOPSIS
  
    $n = 1234;       # decimal integer
    $n = 0b1110011;  # binary integer
    $n = 01234;      # octal integer
    $n = 0x1234;     # hexadecimal integer
    $n = 12.34e-56;  # exponential notation ( currently not working )
  
  =head1 INHERITANCE
  
    PPI::Token::Number
    isa PPI::Token
        isa PPI::Element
  
  =head1 DESCRIPTION
  
  The C<PPI::Token::Number> class is used for tokens that represent numbers,
  in the various types that Perl supports.
  
  =head1 METHODS
  
  =cut
  
  use strict;
  use PPI::Token ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Token';
  }
  
  =pod
  
  =head2 base
  
  The C<base> method is provided by all of the ::Number subclasses.
  This is 10 for decimal, 16 for hexadecimal, 2 for binary, etc.
  
  =cut
  
  sub base {
  	return 10;
  }
  
  =pod
  
  =head2 literal
  
  Return the numeric value of this token.
  
  =cut
  
  sub literal {
  	return 0 + $_[0]->_literal;
  }
  
  sub _literal {
  	# De-sugar the string representation
  	my $self   = shift;
  	my $string = $self->content;
  	$string =~ s/^\+//;
  	$string =~ s/_//g;
  	return $string;
  }
  
  
  
  
  
  #####################################################################
  # Tokenizer Methods
  
  sub __TOKENIZER__on_char {
  	my $class = shift;
  	my $t     = shift;
  	my $char  = substr( $t->{line}, $t->{line_cursor}, 1 );
  
  	# Allow underscores straight through
  	return 1 if $char eq '_';
  
  	# Handle the conversion from an unknown to known type.
  	# The regex covers "potential" hex/bin/octal number.
  	my $token = $t->{token};
  	if ( $token->{content} =~ /^-?0_*$/ ) {
  		# This could be special
  		if ( $char eq 'x' ) {
  			$t->{class} = $t->{token}->set_class( 'Number::Hex' );
  			return 1;
  		} elsif ( $char eq 'b' ) {
  			$t->{class} = $t->{token}->set_class( 'Number::Binary' );
  			return 1;
  		} elsif ( $char =~ /\d/ ) {
  			# You cannot have 8s and 9s on octals
  			if ( $char eq '8' or $char eq '9' ) {
  				$token->{_error} = "Illegal character in octal number '$char'";
  			}
  			$t->{class} = $t->{token}->set_class( 'Number::Octal' );
  			return 1;
  		}
  	}
  
  	# Handle the easy case, integer or real.
  	return 1 if $char =~ /\d/o;
  
  	if ( $char eq '.' ) {
  		$t->{class} = $t->{token}->set_class( 'Number::Float' );
  		return 1;
  	}
  	if ( $char eq 'e' || $char eq 'E' ) {
  		$t->{class} = $t->{token}->set_class( 'Number::Exp' );
  		return 1;
  	}
  
  	# Doesn't fit a special case, or is after the end of the token
  	# End of token.
  	$t->_finalize_token->__TOKENIZER__on_char( $t );
  }
  
  1;
  
  =pod
  
  =head1 CAVEATS
  
  Compared to Perl, the number tokenizer is too liberal about allowing
  underscores anywhere.  For example, the following is a syntax error in
  Perl, but is allowed in PPI:
  
     0_b10
  
  =head1 TO DO
  
  - Treat v-strings as binary strings or barewords, not as "base-256"
    numbers
  
  - Break out decimal integers into their own subclass?
  
  - Implement literal()
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_NUMBER

$fatpacked{"PPI/Token/Number/Binary.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_NUMBER_BINARY';
  package PPI::Token::Number::Binary;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::Number::Binary - Token class for a binary number
  
  =head1 SYNOPSIS
  
    $n = 0b1110011;  # binary integer
  
  =head1 INHERITANCE
  
    PPI::Token::Number::Binary
    isa PPI::Token::Number
        isa PPI::Token
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  The C<PPI::Token::Number::Binary> class is used for tokens that
  represent base-2 numbers.
  
  =head1 METHODS
  
  =cut
  
  use strict;
  use PPI::Token::Number ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Token::Number';
  }
  
  =pod
  
  =head2 base
  
  Returns the base for the number: 2.
  
  =cut
  
  sub base {
  	return 2;
  }
  
  =pod
  
  =head2 literal
  
  Return the numeric value of this token.
  
  =cut
  
  sub literal {
  	my $self = shift;
  	return if $self->{_error};
  	my $str = $self->_literal;
  	my $neg = $str =~ s/^\-//;
  	$str =~ s/^0b//;
  	my $val = 0;
  	for my $bit ( $str =~ m/(.)/g ) {
  		$val = $val * 2 + $bit;
  	}
  	return $neg ? -$val : $val;
  }
  
  
  
  
  
  #####################################################################
  # Tokenizer Methods
  
  sub __TOKENIZER__on_char {
  	my $class = shift;
  	my $t     = shift;
  	my $char  = substr( $t->{line}, $t->{line_cursor}, 1 );
  
  	# Allow underscores straight through
  	return 1 if $char eq '_';
  
  	if ( $char =~ /[\w\d]/ ) {
  		unless ( $char eq '1' or $char eq '0' ) {
  			# Add a warning if it contains non-hex chars
  			$t->{token}->{_error} = "Illegal character in binary number '$char'";
  		}
  		return 1;
  	}
  
  	# Doesn't fit a special case, or is after the end of the token
  	# End of token.
  	$t->_finalize_token->__TOKENIZER__on_char( $t );
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Chris Dolan E<lt>cdolan@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2006 Chris Dolan.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_NUMBER_BINARY

$fatpacked{"PPI/Token/Number/Exp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_NUMBER_EXP';
  package PPI::Token::Number::Exp;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::Number::Exp - Token class for an exponential notation number
  
  =head1 SYNOPSIS
  
    $n = 1.0e-2;
    $n = 1e+2;
  
  =head1 INHERITANCE
  
    PPI::Token::Number::Exp
    isa PPI::Token::Number::Float
        isa PPI::Token::Number
            isa PPI::Token
                isa PPI::Element
  
  =head1 DESCRIPTION
  
  The C<PPI::Token::Number::Exp> class is used for tokens that
  represent floating point numbers with exponential notation.
  
  =head1 METHODS
  
  =cut
  
  use strict;
  use PPI::Token::Number::Float ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Token::Number::Float';
  }
  
  =pod
  
  =head2 literal
  
  Return the numeric value of this token.
  
  =cut
  
  sub literal {
  	my $self = shift;
  	return if $self->{_error};
  	my ($mantissa, $exponent) = split m/e/i, $self->_literal;
  	my $neg = $mantissa =~ s/^\-//;
  	$mantissa =~ s/^\./0./;
  	$exponent =~ s/^\+//;
  	my $val = $mantissa * 10 ** $exponent;
  	return $neg ? -$val : $val;
  }
  
  
  
  
  
  #####################################################################
  # Tokenizer Methods
  
  sub __TOKENIZER__on_char {
  	my $class = shift;
  	my $t     = shift;
  	my $char  = substr( $t->{line}, $t->{line_cursor}, 1 );
  
          # To get here, the token must have already encountered an 'E'
  
  	# Allow underscores straight through
  	return 1 if $char eq '_';
  
  	# Allow digits
  	return 1 if $char =~ /\d/o;
  
  	# Start of exponent is special
  	if ( $t->{token}->{content} =~ /e$/i ) {
  		# Allow leading +/- in exponent
  		return 1 if $char eq '-' || $char eq '+';
  
  		# Invalid character in exponent.  Recover
  		if ( $t->{token}->{content} =~ s/\.(e)$//i ) {
  			my $word = $1;
  			$t->{class} = $t->{token}->set_class('Number');
  			$t->_new_token('Operator', '.');
  			$t->_new_token('Word', $word);
  			return $t->{class}->__TOKENIZER__on_char( $t );
  		}
  		else {
  			$t->{token}->{_error} = "Illegal character in exponent '$char'";
  		}
  	}
  
  	# Doesn't fit a special case, or is after the end of the token
  	# End of token.
  	$t->_finalize_token->__TOKENIZER__on_char( $t );
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Chris Dolan E<lt>cdolan@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2006 Chris Dolan.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_NUMBER_EXP

$fatpacked{"PPI/Token/Number/Float.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_NUMBER_FLOAT';
  package PPI::Token::Number::Float;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::Number::Float - Token class for a floating-point number
  
  =head1 SYNOPSIS
  
    $n = 1.234;
  
  =head1 INHERITANCE
  
    PPI::Token::Number::Float
    isa PPI::Token::Number
        isa PPI::Token
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  The C<PPI::Token::Number::Float> class is used for tokens that
  represent floating point numbers.  A float is identified by n decimal
  point.  Exponential notation (the C<e> or C<E>) is handled by the
  PPI::Token::Number::Exp class.
  
  =head1 METHODS
  
  =cut
  
  use strict;
  use PPI::Token::Number ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Token::Number';
  }
  
  =pod
  
  =head2 base
  
  Returns the base for the number: 10.
  
  =cut
  
  sub base () { 10 }
  
  =pod
  
  =head2 literal
  
  Return the numeric value of this token.
  
  =cut
  
  sub literal {
  	my $self = shift;
  	my $str = $self->_literal;
  	my $neg = $str =~ s/^\-//;
  	$str =~ s/^\./0./;
  	my $val = 0+$str;
  	return $neg ? -$val : $val;
  }
  
  
  
  
  
  #####################################################################
  # Tokenizer Methods
  
  sub __TOKENIZER__on_char {
  	my $class = shift;
  	my $t     = shift;
  	my $char  = substr( $t->{line}, $t->{line_cursor}, 1 );
  
  	# Allow underscores straight through
  	return 1 if $char eq '_';
  
  	# Allow digits
  	return 1 if $char =~ /\d/o;
  
  	# Is there a second decimal point?  Then version string or '..' operator
  	if ( $char eq '.' ) {
  		if ( $t->{token}->{content} =~ /\.$/ ) {
  			# We have a .., which is an operator.
  			# Take the . off the end of the token..
  			# and finish it, then make the .. operator.
  			chop $t->{token}->{content};
                          $t->{class} = $t->{token}->set_class( 'Number' );
  			$t->_new_token('Operator', '..');
  			return 0;
  		} elsif ( $t->{token}->{content} !~ /_/ ) {
  			# Underscore means not a Version, fall through to end token
  			$t->{class} = $t->{token}->set_class( 'Number::Version' );
  			return 1;
  		}
  	}
  	if ($char eq 'e' || $char eq 'E') {
  		$t->{class} = $t->{token}->set_class( 'Number::Exp' );
  		return 1;
  	}
  
  	# Doesn't fit a special case, or is after the end of the token
  	# End of token.
  	$t->_finalize_token->__TOKENIZER__on_char( $t );
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Chris Dolan E<lt>cdolan@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2006 Chris Dolan.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_NUMBER_FLOAT

$fatpacked{"PPI/Token/Number/Hex.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_NUMBER_HEX';
  package PPI::Token::Number::Hex;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::Number::Hex - Token class for a binary number
  
  =head1 SYNOPSIS
  
    $n = 0x1234;     # hexadecimal integer
  
  =head1 INHERITANCE
  
    PPI::Token::Number::Hex
    isa PPI::Token::Number
        isa PPI::Token
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  The C<PPI::Token::Number::Hex> class is used for tokens that
  represent base-16 numbers.
  
  =head1 METHODS
  
  =cut
  
  use strict;
  use PPI::Token::Number ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Token::Number';
  }
  
  =pod
  
  =head2 base
  
  Returns the base for the number: 16.
  
  =cut
  
  sub base () { 16 }
  
  =pod
  
  =head2 literal
  
  Return the numeric value of this token.
  
  =cut
  
  sub literal {
  	my $self = shift;
  	my $str = $self->_literal;
  	my $neg = $str =~ s/^\-//;
  	my $val = hex $str;
  	return $neg ? -$val : $val;
  }
  
  
  
  
  
  #####################################################################
  # Tokenizer Methods
  
  sub __TOKENIZER__on_char {
  	my $class = shift;
  	my $t     = shift;
  	my $char  = substr( $t->{line}, $t->{line_cursor}, 1 );
  
  	# Allow underscores straight through
  	return 1 if $char eq '_';
  
  	if ( $char =~ /[\da-f]/ ) {
  		return 1;
  	}
  
  	# Doesn't fit a special case, or is after the end of the token
  	# End of token.
  	$t->_finalize_token->__TOKENIZER__on_char( $t );
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Chris Dolan E<lt>cdolan@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2006 Chris Dolan.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_NUMBER_HEX

$fatpacked{"PPI/Token/Number/Octal.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_NUMBER_OCTAL';
  package PPI::Token::Number::Octal;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::Number::Octal - Token class for a binary number
  
  =head1 SYNOPSIS
  
    $n = 0777;      # octal integer
  
  =head1 INHERITANCE
  
    PPI::Token::Number::Octal
    isa PPI::Token::Number
        isa PPI::Token
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  The C<PPI::Token::Number::Octal> class is used for tokens that
  represent base-8 numbers.
  
  =head1 METHODS
  
  =cut
  
  use strict;
  use PPI::Token::Number ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Token::Number';
  }
  
  =pod
  
  =head2 base
  
  Returns the base for the number: 8.
  
  =cut
  
  sub base () { 8 }
  
  =pod
  
  =head2 literal
  
  Return the numeric value of this token.
  
  =cut
  
  sub literal {
  	my $self = shift;
  	return if $self->{_error};
  	my $str = $self->_literal;
  	my $neg = $str =~ s/^\-//;
  	my $val = oct $str;
  	return $neg ? -$val : $val;
  }
  
  
  
  
  
  #####################################################################
  # Tokenizer Methods
  
  sub __TOKENIZER__on_char {
  	my $class = shift;
  	my $t     = shift;
  	my $char  = substr( $t->{line}, $t->{line_cursor}, 1 );
  
  	# Allow underscores straight through
  	return 1 if $char eq '_';
  
  	if ( $char =~ /\d/ ) {
  		# You cannot have 8s and 9s on octals
  		if ( $char eq '8' or $char eq '9' ) {
  			$t->{token}->{_error} = "Illegal character in octal number '$char'";
  		}
  		return 1;
  	}
  
  	# Doesn't fit a special case, or is after the end of the token
  	# End of token.
  	$t->_finalize_token->__TOKENIZER__on_char( $t );
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Chris Dolan E<lt>cdolan@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2006 Chris Dolan.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_NUMBER_OCTAL

$fatpacked{"PPI/Token/Number/Version.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_NUMBER_VERSION';
  package PPI::Token::Number::Version;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::Number::Version - Token class for a byte-packed number
  
  =head1 SYNOPSIS
  
    $n = 1.1.0;
    $n = 127.0.0.1;
    $n = 10_000.10_000.10_000;
    $n = v1.2.3.4
  
  =head1 INHERITANCE
  
    PPI::Token::Number::Version
    isa PPI::Token::Number
        isa PPI::Token
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  The C<PPI::Token::Number::Version> class is used for tokens that have
  multiple decimal points.  In truth, these aren't treated like numbers
  at all by Perl, but they look like numbers to a parser.
  
  =head1 METHODS
  
  =cut
  
  use strict;
  use PPI::Token::Number ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Token::Number';
  }
  
  =pod
  
  =head2 base
  
  Returns the base for the number: 256.
  
  =cut
  
  sub base {
  	return 256;
  }
  
  =pod
  
  =head2 literal
  
  Return the numeric value of this token.
  
  =cut
  
  sub literal {
  	my $self    = shift;
  	my $content = $self->{content};
  	$content =~ s/^v//;
  	return join '', map { chr $_ } ( split /\./, $content );
  }
  
  
  
  
  
  #####################################################################
  # Tokenizer Methods
  
  =pod
  
  =begin testing 9
  
  my $doc1 = new_ok( 'PPI::Document' => [ \'1.2.3.4'  ] );
  my $doc2 = new_ok( 'PPI::Document' => [ \'v1.2.3.4' ] );
  isa_ok( $doc1->child(0), 'PPI::Statement' );
  isa_ok( $doc2->child(0), 'PPI::Statement' );
  isa_ok( $doc1->child(0)->child(0), 'PPI::Token::Number::Version' );
  isa_ok( $doc2->child(0)->child(0), 'PPI::Token::Number::Version' );
  
  my $literal1 = $doc1->child(0)->child(0)->literal;
  my $literal2 = $doc2->child(0)->child(0)->literal;
  is( length($literal1), 4, 'The literal length of doc1 is 4' );
  is( length($literal2), 4, 'The literal length of doc1 is 4' );
  is( $literal1, $literal2, 'Literals match for 1.2.3.4 vs v1.2.3.4' );
  
  =end testing
  
  =cut
  
  sub __TOKENIZER__on_char {
  	my $class = shift;
  	my $t     = shift;
  	my $char  = substr( $t->{line}, $t->{line_cursor}, 1 );
  
  	# Allow digits
  	return 1 if $char =~ /\d/o;
  
  	# Is this a second decimal point in a row?  Then the '..' operator
  	if ( $char eq '.' ) {
  		if ( $t->{token}->{content} =~ /\.$/ ) {
  			# We have a .., which is an operator.
  			# Take the . off the end of the token..
  			# and finish it, then make the .. operator.
  			chop $t->{token}->{content};
  			$t->_new_token('Operator', '..');
  			return 0;
  		} else {
  			return 1;
  		}
  	}
  
  	# Doesn't fit a special case, or is after the end of the token
  	# End of token.
  	$t->_finalize_token->__TOKENIZER__on_char( $t );
  }
  
  sub __TOKENIZER__commit {
  	my $t = $_[1];
  
  	# Get the rest of the line
  	my $rest = substr( $t->{line}, $t->{line_cursor} );
  	unless ( $rest =~ /^(v\d+(?:\.\d+)*)/ ) {
  		# This was not a v-string after all (it's a word)
  		return PPI::Token::Word->__TOKENIZER__commit($t);
  	}
  
  	# This is a v-string
  	my $vstring = $1;
  	$t->{line_cursor} += length($vstring);
  	$t->_new_token('Number::Version', $vstring);
  	$t->_finalize_token->__TOKENIZER__on_char($t);
  }
  
  1;
  
  =pod
  
  =head1 BUGS
  
  - Does not handle leading minus sign correctly. Should translate to a DashedWord.
  See L<http://perlmonks.org/?node_id=574573>
  
    -95.0.1.0  --> "-_\000\cA\000"
    -96.0.1.0  --> Argument "`\0^A\0" isn't numeric in negation (-)
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Chris Dolan E<lt>cdolan@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2006 Chris Dolan.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_NUMBER_VERSION

$fatpacked{"PPI/Token/Operator.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_OPERATOR';
  package PPI::Token::Operator;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::Operator - Token class for operators
  
  =head1 INHERITANCE
  
    PPI::Token::Operator
    isa PPI::Token
        isa PPI::Element
  
  =head1 SYNOPSIS
  
    # This is the list of valid operators
    ++   --   **   !    ~    +    -
    =~   !~   *    /    %    x
    <<   >>   lt   gt   le   ge   cmp  ~~
    ==   !=   <=>  .    ..   ...  ,
    &    |    ^    &&   ||   //
    ?    :    =    +=   -=   *=   .=   //=
    <    >    <=   >=   <>   =>   ->
    and  or   dor  not  eq   ne
  
  =head1 DESCRIPTION
  
  All operators in PPI are created as C<PPI::Token::Operator> objects,
  including the ones that may superficially look like a L<PPI::Token::Word>
  object.
  
  =head1 METHODS
  
  There are no additional methods beyond those provided by the parent
  L<PPI::Token> and L<PPI::Element> classes.
  
  Got any ideas for methods? Submit a report to rt.cpan.org!
  
  =cut
  
  use strict;
  use PPI::Token ();
  
  use vars qw{$VERSION @ISA %OPERATOR};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Token';
  
  	# Build the operator index
  	### NOTE - This is accessed several times explicitly
  	###        in PPI::Token::Word. Do not rename this
  	###        without also correcting them.
  	%OPERATOR = map { $_ => 1 } (
  		qw{
  		-> ++ -- ** ! ~ + -
  		=~ !~ * / % x . << >>
  		< > <= >= lt gt le ge
  		== != <=> eq ne cmp ~~
  		& | ^ && || // .. ...
  		? : = += -= *= .= /= //=
  		=> <>
  		and or xor not
  		}, ',' 	# Avoids "comma in qw{}" warning
  		);
  }
  
  
  
  
  
  #####################################################################
  # Tokenizer Methods
  
  sub __TOKENIZER__on_char {
  	my $t    = $_[1];
  	my $char = substr( $t->{line}, $t->{line_cursor}, 1 );
  
  	# Are we still an operator if we add the next character
  	my $content = $t->{token}->{content};
  	return 1 if $OPERATOR{ $content . $char };
  
  	# Handle the special case of a .1234 decimal number
  	if ( $content eq '.' ) {
  		if ( $char =~ /^[0-9]$/ ) {
  			# This is a decimal number
  			$t->{class} = $t->{token}->set_class('Number::Float');
  			return $t->{class}->__TOKENIZER__on_char( $t );
  		}
  	}
  
  	# Handle the special case if we might be a here-doc
  	if ( $content eq '<<' ) {
  		my $line = substr( $t->{line}, $t->{line_cursor} );
  		# Either <<FOO or << 'FOO' or <<\FOO
  		### Is the zero-width look-ahead assertion really
  		### supposed to be there?
  		if ( $line =~ /^(?: (?!\d)\w | \s*['"`] | \\\w ) /x ) {
  			# This is a here-doc.
  			# Change the class and move to the HereDoc's own __TOKENIZER__on_char method.
  			$t->{class} = $t->{token}->set_class('HereDoc');
  			return $t->{class}->__TOKENIZER__on_char( $t );
  		}
  	}
  
  	# Handle the special case of the null Readline
  	if ( $content eq '<>' ) {
  		$t->{class} = $t->{token}->set_class('QuoteLike::Readline');
  	}
  
  	# Finalize normally
  	$t->_finalize_token->__TOKENIZER__on_char( $t );
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_OPERATOR

$fatpacked{"PPI/Token/Pod.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_POD';
  package PPI::Token::Pod;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::Pod - Sections of POD in Perl documents
  
  =head1 INHERITANCE
  
    PPI::Token::Pod
    isa PPI::Token
        isa PPI::Element
  
  =head1 DESCRIPTION
  
  A single C<PPI::Token::Pod> object represents a complete section of POD
  documentation within a Perl document.
  
  =head1 METHODS
  
  This class provides some additional methods beyond those provided by its
  L<PPI::Token> and L<PPI::Element> parent classes.
  
  Got any ideas for more methods? Submit a report to rt.cpan.org!
  
  =cut
  
  use strict;
  use Params::Util qw{_INSTANCE};
  use PPI::Token   ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Token';
  }
  
  
  
  
  
  #####################################################################
  # PPI::Token::Pod Methods
  
  =pod
  
  =head2 merge @podtokens
  
  The C<merge> constructor takes a number of C<PPI::Token::Pod> objects,
  and returns a new object that represents one combined POD block with
  the content of all of them.
  
  Returns a new C<PPI::Token::Pod> object, or C<undef> on error.
  
  =begin testing merge after PPI::Node 4
  
  # Create the test fragments
  my $one = PPI::Token::Pod->new("=pod\n\nOne\n\n=cut\n");
  my $two = PPI::Token::Pod->new("=pod\n\nTwo");
  isa_ok( $one, 'PPI::Token::Pod' );
  isa_ok( $two, 'PPI::Token::Pod' );
  
  # Create the combined Pod
  my $merged = PPI::Token::Pod->merge($one, $two);
  isa_ok( $merged, 'PPI::Token::Pod' );
  is( $merged->content, "=pod\n\nOne\n\nTwo\n\n=cut\n", 'Merged POD looks ok' );
  
  =end testing
  
  =cut
  
  sub merge {
  	my $class = (! ref $_[0]) ? shift : return undef;
  
  	# Check there are no bad arguments
  	if ( grep { ! _INSTANCE($_, 'PPI::Token::Pod') } @_ ) {
  		return undef;
  	}
  
  	# Get the tokens, and extract the lines
  	my @content = ( map { [ $_->lines ] } @_ ) or return undef;
  
  	# Remove the leading =pod tags, trailing =cut tags, and any empty lines
  	# between them and the pod contents.
  	foreach my $pod ( @content ) {
  		# Leading =pod tag
  		if ( @$pod and $pod->[0] =~ /^=pod\b/o ) {
  			shift @$pod;
  		}
  
  		# Trailing =cut tag
  		if ( @$pod and $pod->[-1] =~ /^=cut\b/o ) {
  			pop @$pod;
  		}
  
  		# Leading and trailing empty lines
  		while ( @$pod and $pod->[0]  eq '' ) { shift @$pod }
  		while ( @$pod and $pod->[-1] eq '' ) { pop @$pod   }
  	}
  
  	# Remove any empty pod sections, and add the =pod and =cut tags
  	# for the merged pod back to it.
  	@content = ( [ '=pod' ], grep { @$_ } @content, [ '=cut' ] );
  
  	# Create the new object
  	$class->new( join "\n", map { join( "\n", @$_ ) . "\n" } @content );
  }
  
  =pod
  
  =head2 lines
  
  The C<lines> method takes the string of POD and breaks it into lines,
  returning them as a list.
  
  =cut
  
  sub lines {
  	split /(?:\015{1,2}\012|\015|\012)/, $_[0]->{content};
  }
  
  
  
  
  
  
  #####################################################################
  # PPI::Element Methods
  
  ### XS -> PPI/XS.xs:_PPI_Token_Pod__significant 0.900+
  sub significant { '' }
  
  
  
  
  
  #####################################################################
  # Tokenizer Methods
  
  sub __TOKENIZER__on_line_start {
  	my $t = $_[1];
  
  	# Add the line to the token first
  	$t->{token}->{content} .= $t->{line};
  
  	# Check the line to see if it is a =cut line
  	if ( $t->{line} =~ /^=(\w+)/ ) {
  		# End of the token
  		$t->_finalize_token if lc $1 eq 'cut';
  	}
  
  	0;
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_POD

$fatpacked{"PPI/Token/Prototype.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_PROTOTYPE';
  package PPI::Token::Prototype;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::Prototype - A subroutine prototype descriptor
  
  =head1 INHERITANCE
  
    PPI::Token::End
    isa PPI::Token
        isa PPI::Element
  
  =head1 SYNOPSIS
  
    sub ($@) prototype;
  
  =head1 DESCRIPTION
  
  Although it sort of looks like a list or condition, a subroutine
  prototype is a lot more like a string. Its job is to provide hints
  to the perl compiler on what type of arguments a particular subroutine
  expects, which the compiler uses to validate parameters at compile-time,
  and allows programmers to use the functions without explicit parameter
  braces.
  
  Due to the rise of OO Perl coding, which ignores these prototypes, they
  are most often used to allow for constant-like things, and to "extend"
  the language and create things that act like keywords and core functions.
  
    # Create something that acts like a constant
    sub MYCONSTANT () { 10 }
    
    # Create the "any" core-looking function
    sub any (&@) { ... }
    
    if ( any { $_->cute } @babies ) {
    	...
    }
  
  =head1 METHODS
  
  This class provides one additional method beyond those defined by the
  L<PPI::Token> and L<PPI::Element> parent classes.
  
  =cut
  
  use strict;
  use PPI::Token ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Token';
  }
  
  sub __TOKENIZER__on_char {
  	my $class = shift;
  	my $t     = shift;
  
  	# Suck in until we find the closing bracket (or the end of line)
  	my $line = substr( $t->{line}, $t->{line_cursor} );
  	if ( $line =~ /^(.*?(?:\)|$))/ ) {
  		$t->{token}->{content} .= $1;
  		$t->{line_cursor} += length $1;
  	}
  
  	# Shortcut if end of line
  	return 0 unless $1 =~ /\)$/;
  
  	# Found the closing bracket
  	$t->_finalize_token->__TOKENIZER__on_char( $t );
  }
  
  =pod
  
  =head2 prototype
  
  The C<prototype> accessor returns the actual prototype pattern, stripped
  of braces and any whitespace inside the pattern.
  
  =cut
  
  sub prototype {
  	my $self  = shift;
  	my $proto = $self->content;
  	$proto =~ s/\(\)\s//g; # Strip brackets and whitespace
  	$proto;
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_PROTOTYPE

$fatpacked{"PPI/Token/Quote.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_QUOTE';
  package PPI::Token::Quote;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::Quote - String quote abstract base class
  
  =head1 INHERITANCE
  
    PPI::Token::Quote
    isa PPI::Token
        isa PPI::Element
  
  =head1 DESCRIPTION
  
  The C<PPI::Token::Quote> class is never instantiated, and simply
  provides a common abstract base class for the four quote classes.
  In PPI, a "quote" is limited to only the quote-like things that
  themselves directly represent a string. (although this includes
  double quotes with interpolated elements inside them).
  
  The subclasses of C<PPI::Token::Quote> are:
  
  =over 2
  
  =item C<''> - L<PPI::Token::Quote::Single>
  
  =item C<q{}> - L<PPI::Token::Quote::Literal>
  
  =item C<""> - L<PPI::Token::Quote::Double>
  
  =item C<qq{}> - L<PPI::Token::Quote::Interpolate>
  
  =back
  
  The names are hopefully obvious enough not to have to explain what
  each class is here. See their respective pages for more details.
  
  Please note that although the here-doc B<does> represent a literal
  string, it is such a nasty piece of work that in L<PPI> it is given the
  honor of its own token class (L<PPI::Token::HereDoc>).
  
  =head1 METHODS
  
  =cut
  
  use strict;
  use PPI::Token ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Token';
  }
  
  
  
  
  
  #####################################################################
  # PPI::Token::Quote Methods
  
  =pod
  
  =head2 string
  
  The C<string> method is provided by all four ::Quote classes. It won't
  get you the actual literal Perl value, but it will strip off the wrapping
  of the quotes.
  
    # The following all return foo from the ->string method
    'foo'
    "foo"
    q{foo}
    qq <foo>
  
  =begin testing string 15
  
  # Prove what we say in the ->string docs
  my $Document = PPI::Document->new(\<<'END_PERL');
    'foo'
    "foo"
    q{foo}
    qq <foo>
  END_PERL
  isa_ok( $Document, 'PPI::Document' );
  
  my $quotes = $Document->find('Token::Quote');
  is( ref($quotes), 'ARRAY', 'Found quotes' );
  is( scalar(@$quotes), 4, 'Found 4 quotes' );
  foreach my $Quote ( @$quotes ) {
  	isa_ok( $Quote, 'PPI::Token::Quote');
  	can_ok( $Quote, 'string'           );
  	is( $Quote->string, 'foo', '->string returns "foo" for '
  		. $Quote->content );
  }
  
  =end testing
  
  =cut
  
  #sub string {
  #	my $class = ref $_[0] || $_[0];
  #	die "$class does not implement method ->string";
  #}
  
  =pod
  
  =head2 literal
  
  The C<literal> method is provided by ::Quote:Literal and
  ::Quote::Single.  This returns the value of the string as Perl sees
  it: without the quote marks and with C<\\> and C<\'> resolved to C<\>
  and C<'>.
  
  The C<literal> method is not implemented by ::Quote::Double or
  ::Quote::Interpolate yet.
  
  =cut
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_QUOTE

$fatpacked{"PPI/Token/Quote/Double.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_QUOTE_DOUBLE';
  package PPI::Token::Quote::Double;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::Quote::Double - A standard "double quote" token
  
  =head1 INHERITANCE
  
    PPI::Token::Quote::Double
    isa PPI::Token::Quote
        isa PPI::Token
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  A C<PPI::Token::Quote::Double> object represents a double-quoted
  interpolating string.
  
  The string is treated as a single entity, L<PPI> will not try to
  understand what is in the string during the parsing process.
  
  =head1 METHODS
  
  There are several methods available for C<PPI::Token::Quote::Double>, beyond
  those provided by the parent L<PPI::Token::Quote>, L<PPI::Token> and
  L<PPI::Element> classes.
  
  Got any ideas for methods? Submit a report to rt.cpan.org!
  
  =cut
  
  use strict;
  use Params::Util                     qw{_INSTANCE};
  use PPI::Token::Quote                ();
  use PPI::Token::_QuoteEngine::Simple ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = qw{
  		PPI::Token::_QuoteEngine::Simple
  		PPI::Token::Quote
  	};
  }
  
  
  
  
  
  #####################################################################
  # PPI::Token::Quote::Double Methods
  
  =pod
  
  =head2 interpolations
  
  The interpolations method checks to see if the double quote actually
  contains any interpolated variables.
  
  Returns true if the string contains interpolations, or false if not.
  
  =begin testing interpolations 8
  
  # Get a set of objects
  my $Document = PPI::Document->new(\<<'END_PERL');
  "no interpolations"
  "no \@interpolations"
  "has $interpolation"
  "has @interpolation"
  "has \\@interpolation"
  "" # False content to test double-negation scoping
  END_PERL
  isa_ok( $Document, 'PPI::Document' );
  my $strings = $Document->find('Token::Quote::Double');
  is( scalar @{$strings}, 6, 'Found the 6 test strings' );
  is( $strings->[0]->interpolations, '', 'String 1: No interpolations'  );
  is( $strings->[1]->interpolations, '', 'String 2: No interpolations'  );
  is( $strings->[2]->interpolations, 1,  'String 3: Has interpolations' );
  is( $strings->[3]->interpolations, 1,  'String 4: Has interpolations' );
  is( $strings->[4]->interpolations, 1,  'String 5: Has interpolations' );
  is( $strings->[5]->interpolations, '', 'String 6: No interpolations'  );
  
  =end testing
  
  =cut
  
  # Upgrade: Return the interpolated substrings.
  # Upgrade: Returns parsed expressions.
  sub interpolations {
  	# Are there any unescaped $things in the string
  	!! ($_[0]->content =~ /(?<!\\)(?:\\\\)*[\$\@]/);
  }
  
  =pod
  
  =head2 simplify
  
  For various reasons, some people find themselves compelled to have
  their code in the simplest form possible.
  
  The C<simply> method will turn a simple double-quoted string into the
  equivalent single-quoted string.
  
  If the double can be simplified, it will be modified in place and
  returned as a convenience, or returns false if the string cannot be
  simplified.
  
  =begin testing simplify 8
  
  my $Document = PPI::Document->new(\<<'END_PERL');
  "no special characters"
  "has \"double\" quotes"
  "has 'single' quotes"
  "has $interpolation"
  "has @interpolation"
  ""
  END_PERL
  isa_ok( $Document, 'PPI::Document' );
  my $strings = $Document->find('Token::Quote::Double');
  is( scalar @{$strings}, 6, 'Found the 6 test strings' );
  is( $strings->[0]->simplify, q<'no special characters'>, 'String 1: No special characters' );
  is( $strings->[1]->simplify, q<"has \"double\" quotes">, 'String 2: Double quotes'         );
  is( $strings->[2]->simplify, q<"has 'single' quotes">,   'String 3: Single quotes'         );
  is( $strings->[3]->simplify, q<"has $interpolation">,    'String 3: Has interpolation'     );
  is( $strings->[4]->simplify, q<"has @interpolation">,    'String 4: Has interpolation'     );
  is( $strings->[5]->simplify, q<''>,                      'String 6: Empty string'          );
  
  =end testing
  
  =cut
  
  sub simplify {
  	# This only works on EXACTLY this class
  	my $self = _INSTANCE(shift, 'PPI::Token::Quote::Double') or return undef;
  
  	# Don't bother if there are characters that could complicate things
  	my $content = $self->content;
  	my $value   = substr($content, 1, length($content) - 2);
  	return $self if $value =~ /[\\\$@\'\"]/;
  
  	# Change the token to a single string
  	$self->{content} = "'$value'";
  	bless $self, 'PPI::Token::Quote::Single';
  }
  
  
  
  
  
  
  
  #####################################################################
  # PPI::Token::Quote Methods
  
  =pod
  
  =begin testing string 3
  
  my $Document = PPI::Document->new( \'print "foo";' );
  isa_ok( $Document, 'PPI::Document' );
  my $Double = $Document->find_first('Token::Quote::Double');
  isa_ok( $Double, 'PPI::Token::Quote::Double' );
  is( $Double->string, 'foo', '->string returns as expected' );
  
  =end testing
  
  =cut
  
  sub string {
  	my $str = $_[0]->{content};
  	substr( $str, 1, length($str) - 2 );
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_QUOTE_DOUBLE

$fatpacked{"PPI/Token/Quote/Interpolate.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_QUOTE_INTERPOLATE';
  package PPI::Token::Quote::Interpolate;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::Quote::Interpolate - The interpolation quote-like operator
  
  =head1 INHERITANCE
  
    PPI::Token::Quote::Interpolate
    isa PPI::Token::Quote
        isa PPI::Token
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  A C<PPI::Token::Quote::Interpolate> object represents a single
  interpolation quote-like operator, such as C<qq{$foo bar $baz}>.
  
  =head1 METHODS
  
  There are no methods available for C<PPI::Token::Quote::Interpolate>
  beyond those provided by the parent L<PPI::Token::Quote>, L<PPI::Token> and
  L<PPI::Element> classes.
  
  Got any ideas for methods? Submit a report to rt.cpan.org!
  
  =cut
  
  use strict;
  use PPI::Token::Quote ();
  use PPI::Token::_QuoteEngine::Full ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = qw{
  		PPI::Token::_QuoteEngine::Full
  		PPI::Token::Quote
  	};
  }
  
  
  
  
  
  #####################################################################
  # PPI::Token::Quote Methods
  
  =pod
  
  =begin testing string 8
  
  my $Document = PPI::Document->new( \"print qq{foo}, qq!bar!, qq <foo>;" );
  isa_ok( $Document, 'PPI::Document' );
  my $Interpolate = $Document->find('Token::Quote::Interpolate');
  is( scalar(@$Interpolate), 3, '->find returns three objects' );
  isa_ok( $Interpolate->[0], 'PPI::Token::Quote::Interpolate' );
  isa_ok( $Interpolate->[1], 'PPI::Token::Quote::Interpolate' );
  isa_ok( $Interpolate->[2], 'PPI::Token::Quote::Interpolate' );
  is( $Interpolate->[0]->string, 'foo', '->string returns as expected' );
  is( $Interpolate->[1]->string, 'bar', '->string returns as expected' );
  is( $Interpolate->[2]->string, 'foo', '->string returns as expected' );
  
  =end testing
  
  =cut
  
  sub string {
  	my $self     = shift;
  	my @sections = $self->_sections;
  	my $str      = $sections[0];
  	substr( $self->{content}, $str->{position}, $str->{size} );	
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_QUOTE_INTERPOLATE

$fatpacked{"PPI/Token/Quote/Literal.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_QUOTE_LITERAL';
  package PPI::Token::Quote::Literal;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::Quote::Literal - The literal quote-like operator
  
  =head1 INHERITANCE
  
    PPI::Token::Quote::Literal
    isa PPI::Token::Quote
        isa PPI::Token
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  A C<PPI::Token::Quote::Literal> object represents a single literal
  quote-like operator, such as C<q{foo bar}>.
  
  =head1 METHODS
  
  There are no methods available for C<PPI::Token::Quote::Literal> beyond
  those provided by the parent L<PPI::Token::Quote>, L<PPI::Token> and
  L<PPI::Element> classes.
  
  Got any ideas for methods? Submit a report to rt.cpan.org!
  
  =cut
  
  use strict;
  use PPI::Token::Quote              ();
  use PPI::Token::_QuoteEngine::Full ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = qw{
  		PPI::Token::_QuoteEngine::Full
  		PPI::Token::Quote
  	};
  }
  
  
  
  
  
  #####################################################################
  # PPI::Token::Quote Methods
  
  =pod
  
  =begin testing string 8
  
  my $Document = PPI::Document->new( \"print q{foo}, q!bar!, q <foo>;" );
  isa_ok( $Document, 'PPI::Document' );
  my $literal = $Document->find('Token::Quote::Literal');
  is( scalar(@$literal), 3, '->find returns three objects' );
  isa_ok( $literal->[0], 'PPI::Token::Quote::Literal' );
  isa_ok( $literal->[1], 'PPI::Token::Quote::Literal' );
  isa_ok( $literal->[2], 'PPI::Token::Quote::Literal' );
  is( $literal->[0]->string, 'foo', '->string returns as expected' );
  is( $literal->[1]->string, 'bar', '->string returns as expected' );
  is( $literal->[2]->string, 'foo', '->string returns as expected' );
  
  =end testing
  
  =cut
  
  sub string {
  	my $self     = shift;
  	my @sections = $self->_sections;
  	my $str      = $sections[0];
  	substr( $self->{content}, $str->{position}, $str->{size} );	
  }
  
  =pod
  
  =begin testing literal 4
  
  my $Document = PPI::Document->new( \"print q{foo}, q!bar!, q <foo>;" );
  isa_ok( $Document, 'PPI::Document' );
  my $literal = $Document->find('Token::Quote::Literal');
  is( $literal->[0]->literal, 'foo', '->literal returns as expected' );
  is( $literal->[1]->literal, 'bar', '->literal returns as expected' );
  is( $literal->[2]->literal, 'foo', '->literal returns as expected' );
  
  =end testing
  
  =cut
  
  *literal = *PPI::Token::Quote::Single::literal;
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_QUOTE_LITERAL

$fatpacked{"PPI/Token/Quote/Single.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_QUOTE_SINGLE';
  package PPI::Token::Quote::Single;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::Quote::Single - A 'single quote' token
  
  =head1 INHERITANCE
  
    PPI::Token::Quote::Single
    isa PPI::Token::Quote
        isa PPI::Token
            isa PPI::Element
  
  =head1 SYNOPSIS
  
    'This is a single quote'
    
    q{This is a literal, but NOT a single quote}
  
  =head1 DESCRIPTION
  
  A C<PPI::Token::Quote::Single> object represents a single quoted string
  literal. 
  
  =head1 METHODS
  
  There are no methods available for C<PPI::Token::Quote::Single> beyond
  those provided by the parent L<PPI::Token::Quote>, L<PPI::Token> and
  L<PPI::Element> classes.
  
  Got any ideas for methods? Submit a report to rt.cpan.org!
  
  =cut
  
  use strict;
  use PPI::Token::Quote ();
  use PPI::Token::_QuoteEngine::Simple ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = qw{
  		PPI::Token::_QuoteEngine::Simple
  		PPI::Token::Quote
  	};
  }
  
  
  
  
  
  #####################################################################
  # PPI::Token::Quote Methods
  
  =pod
  
  =begin testing string 3
  
  my $Document = PPI::Document->new( \"print 'foo';" );
  isa_ok( $Document, 'PPI::Document' );
  my $Single = $Document->find_first('Token::Quote::Single');
  isa_ok( $Single, 'PPI::Token::Quote::Single' );
  is( $Single->string, 'foo', '->string returns as expected' );
  
  =end testing
  
  =cut
  
  sub string {
  	my $str = $_[0]->{content};
  	substr( $str, 1, length($str) - 2 );
  }
  
  =pod
  
  =begin testing literal 21
  
  my @pairs = (
  	"''",          '',
  	"'f'",         'f',
  	"'f\\'b'",     "f\'b",
  	"'f\\nb'",     "f\\nb",
  	"'f\\\\b'",    "f\\b",
  	"'f\\\\\\b'", "f\\\\b",
  	"'f\\\\\\\''", "f\\'",
  );
  while ( @pairs ) {
  	my $from  = shift @pairs;
  	my $to    = shift @pairs;
  	my $doc   = PPI::Document->new( \"print $from;" );
  	isa_ok( $doc, 'PPI::Document' );
  	my $quote = $doc->find_first('Token::Quote::Single');
  	isa_ok( $quote, 'PPI::Token::Quote::Single' );
  	is( $quote->literal, $to, "The source $from becomes $to ok" );
  }
  
  =end testing 
  
  =cut
  
  my %UNESCAPE = (
  	"\\'"  => "'",
  	"\\\\" => "\\",
  );
  
  sub literal {
  	# Unescape \\ and \' ONLY
  	my $str = $_[0]->string;
  	$str =~ s/(\\.)/$UNESCAPE{$1} || $1/ge;
  	return $str;
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_QUOTE_SINGLE

$fatpacked{"PPI/Token/QuoteLike.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_QUOTELIKE';
  package PPI::Token::QuoteLike;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::QuoteLike - Quote-like operator abstract base class
  
  =head1 INHERITANCE
  
    PPI::Token::QuoteLike
    isa PPI::Token
        isa PPI::Element
  
  =head1 DESCRIPTION
  
  The C<PPI::Token::QuoteLike> class is never instantiated, and simply
  provides a common abstract base class for the five quote-like operator
  classes. In PPI, a "quote-like" is the set of quote-like things that
  exclude the string quotes and regular expressions.
  
  The subclasses of C<PPI::Token::QuoteLike> are:
  
  =over 2
  
  =item qw{} - L<PPI::Token::QuoteLike::Words>
  
  =item `` - L<PPI::Token::QuoteLike::Backtick>
  
  =item qx{} - L<PPI::Token::QuoteLike::Command>
  
  =item qr// - L<PPI::Token::QuoteLike::Regexp>
  
  =item <FOO> - L<PPI::Token::QuoteLike::Readline>
  
  =back
  
  The names are hopefully obvious enough not to have to explain what
  each class is. See their pages for more details.
  
  You may note that the backtick and command quote-like are treated
  separately, even though they do the same thing. This is intentional,
  as the inherit from and are processed by two different parts of the
  PPI's quote engine.
  
  =cut
  
  use strict;
  use PPI::Token ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Token';
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_QUOTELIKE

$fatpacked{"PPI/Token/QuoteLike/Backtick.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_QUOTELIKE_BACKTICK';
  package PPI::Token::QuoteLike::Backtick;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::QuoteLike::Backtick - A `backticks` command token
  
  =head1 INHERITANCE
  
    PPI::Token::QuoteLike::Backtick
    isa PPI::Token::QuoteLike
        isa PPI::Token
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  A C<PPI::Token::QuoteLike::Backtick> object represents a command output
  capturing quote.
  
  =head1 METHODS
  
  There are no methods available for C<PPI::Token::QuoteLike::Backtick>
  beyond those provided by the parent L<PPI::Token::QuoteLike>, L<PPI::Token>
  and L<PPI::Element> classes.
  
  Got any ideas for methods? Submit a report to rt.cpan.org!
  
  =cut
  
  use strict;
  use PPI::Token::QuoteLike            ();
  use PPI::Token::_QuoteEngine::Simple ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = qw{
  		PPI::Token::_QuoteEngine::Simple
  		PPI::Token::QuoteLike
  	};
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_QUOTELIKE_BACKTICK

$fatpacked{"PPI/Token/QuoteLike/Command.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_QUOTELIKE_COMMAND';
  package PPI::Token::QuoteLike::Command;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::QuoteLike::Command - The command quote-like operator
  
  =head1 INHERITANCE
  
    PPI::Token::QuoteLike::Command
    isa PPI::Token::QuoteLike
        isa PPI::Token
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  A C<PPI::Token::QuoteLike::Command> object represents a command output
  capturing quote-like operator.
  
  =head1 METHODS
  
  There are no methods available for C<PPI::Token::QuoteLike::Command>
  beyond those provided by the parent L<PPI::Token::QuoteLike>, L<PPI::Token>
  and L<PPI::Element> classes.
  
  Got any ideas for methods? Submit a report to rt.cpan.org!
  
  =cut
  
  use strict;
  use PPI::Token::QuoteLike          ();
  use PPI::Token::_QuoteEngine::Full ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = qw{
  		PPI::Token::_QuoteEngine::Full
  		PPI::Token::QuoteLike
  	};
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_QUOTELIKE_COMMAND

$fatpacked{"PPI/Token/QuoteLike/Readline.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_QUOTELIKE_READLINE';
  package PPI::Token::QuoteLike::Readline;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::QuoteLike::Readline - The readline quote-like operator
  
  =head1 INHERITANCE
  
    PPI::Token::QuoteLike::Readline
    isa PPI::Token::QuoteLike
        isa PPI::Token
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  The C<readline> quote-like operator is used to read either a single
  line from a file, or all the lines from a file, as follows.
  
    # Read in a single line
    $line = <FILE>;
    
    # From a scalar handle
    $line = <$filehandle>;
    
    # Read all the lines
    @lines = <FILE>;
  
  =head1 METHODS
  
  There are no methods available for C<PPI::Token::QuoteLike::Readline>
  beyond those provided by the parent L<PPI::Token::QuoteLike>, L<PPI::Token>
  and L<PPI::Element> classes.
  
  Got any ideas for methods? Submit a report to rt.cpan.org!
  
  =cut
  
  use strict;
  use PPI::Token::QuoteLike          ();
  use PPI::Token::_QuoteEngine::Full ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = qw{
  		PPI::Token::_QuoteEngine::Full
  		PPI::Token::QuoteLike
  	};
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_QUOTELIKE_READLINE

$fatpacked{"PPI/Token/QuoteLike/Regexp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_QUOTELIKE_REGEXP';
  package PPI::Token::QuoteLike::Regexp;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::QuoteLike::Regexp - Regexp constructor quote-like operator
  
  =head1 INHERITANCE
  
    PPI::Token::QuoteLike::Regexp
    isa PPI::Token::QuoteLike
        isa PPI::Token
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  A C<PPI::Token::QuoteLike::Regexp> object represents the quote-like
  operator used to construct anonymous L<Regexp> objects, as follows.
  
    # Create a Regexp object for a module filename
    my $module = qr/\.pm$/;
  
  =head1 METHODS
  
  The following methods are provided by this class,
  beyond those provided by the parent L<PPI::Token::QuoteLike>,
  L<PPI::Token> and L<PPI::Element> classes.
  
  =cut
  
  use strict;
  use PPI::Token::QuoteLike          ();
  use PPI::Token::_QuoteEngine::Full ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = qw{
  		PPI::Token::_QuoteEngine::Full
  		PPI::Token::QuoteLike
  	};
  }
  
  
  
  
  
  #####################################################################
  # PPI::Token::QuoteLike::Regexp Methods
  
  =pod
  
  =head2 get_match_string
  
  The C<get_match_string> method returns the portion of the string that
  will be compiled into the match portion of the regexp.
  
  =cut
  
  sub get_match_string {
  	return $_[0]->_section_content( 0 );
  }
  
  =pod
  
  =head2 get_substitute_string
  
  The C<get_substitute_string> method always returns C<undef>, since
  the C<qr{}> construction provides no substitution string. This method
  is provided for orthogonality with C<PPI::Token::Regexp>.
  
  =cut
  
  sub get_substitute_string {
  	return undef;
  }
  
  =pod
  
  =head2 get_modifiers
  
  The C<get_modifiers> method returns the modifiers that will be
  compiled into the regexp.
  
  =cut
  
  sub get_modifiers {
  	return $_[0]->_modifiers();
  }
  
  =pod
  
  =head2 get_delimiters
  
  The C<get_delimiters> method returns the delimiters of the string as an
  array. The first and only element is the delimiters of the string to be
  compiled into a match string.
  
  =cut
  
  sub get_delimiters {
  	return $_[0]->_delimiters();
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_QUOTELIKE_REGEXP

$fatpacked{"PPI/Token/QuoteLike/Words.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_QUOTELIKE_WORDS';
  package PPI::Token::QuoteLike::Words;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::QuoteLike::Words - Word list constructor quote-like operator
  
  =head1 INHERITANCE
  
    PPI::Token::QuoteLike::Words
    isa PPI::Token::QuoteLike
        isa PPI::Token
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  A C<PPI::Token::QuoteLike::Words> object represents a quote-like operator
  that acts as a constructor for a list of words.
  
    # Create a list for a significant chunk of the alphabet
    my @list = qw{a b c d e f g h i j k l};
  
  =head1 METHODS
  
  =cut
  
  use strict;
  use PPI::Token::QuoteLike          ();
  use PPI::Token::_QuoteEngine::Full ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = qw{
  		PPI::Token::_QuoteEngine::Full
  		PPI::Token::QuoteLike
  	};
  }
  
  =pod
  
  =head2 literal
  
  Returns the words contained.  Note that this method does not check the
  context that the token is in; it always returns the list and not merely
  the last element if the token is in scalar context.
  
  =begin testing literal 12
  
  my $empty_list_document = PPI::Document->new(\<<'END_PERL');
  qw//
  qw/    /
  END_PERL
  
  isa_ok( $empty_list_document, 'PPI::Document' );
  my $empty_list_tokens =
  	$empty_list_document->find('PPI::Token::QuoteLike::Words');
  is( scalar @{$empty_list_tokens}, 2, 'Found expected empty word lists.' );
  foreach my $token ( @{$empty_list_tokens} ) {
  	my @literal = $token->literal;
  	is( scalar @literal, 0, qq<No elements for "$token"> );
  }
  
  my $non_empty_list_document = PPI::Document->new(\<<'END_PERL');
  qw/foo bar baz/
  qw/  foo bar baz  /
  qw {foo bar baz}
  END_PERL
  my @expected = qw/ foo bar baz /;
  
  isa_ok( $non_empty_list_document, 'PPI::Document' );
  my $non_empty_list_tokens =
  	$non_empty_list_document->find('PPI::Token::QuoteLike::Words');
  is(
  	scalar(@$non_empty_list_tokens),
  	3,
  	'Found expected non-empty word lists.',
  );
  foreach my $token ( @$non_empty_list_tokens ) {
  	my $literal = $token->literal;
  	is(
  		$literal,
  		scalar @expected,
  		qq<Scalar context literal() returns the list for "$token">,
  	);
  	my @literal = $token->literal;
  	is_deeply( [ $token->literal ], \@expected, '->literal matches expected' );
  }
  
  =end testing
  
  =cut
  
  sub literal {
  	my $self    = shift;
  	my $section = $self->{sections}->[0];
  	return split ' ', substr(
  		$self->{content},
  		$section->{position},
  		$section->{size},
  	);
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_QUOTELIKE_WORDS

$fatpacked{"PPI/Token/Regexp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_REGEXP';
  package PPI::Token::Regexp;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::Regexp - Regular expression abstract base class
  
  =head1 INHERITANCE
  
    PPI::Token::Regexp
    isa PPI::Token
        isa PPI::Element
  
  =head1 DESCRIPTION
  
  The C<PPI::Token::Regexp> class is never instantiated, and simply
  provides a common abstract base class for the three regular expression
  classes. These being:
  
  =over 2
  
  =item m// - L<PPI::Token::Regexp::Match>
  
  =item s/// - L<PPI::Token::Regexp::Substitute>
  
  =item tr/// - L<PPI::Token::Regexp::Transliterate>
  
  =back
  
  The names are hopefully obvious enough not to have to explain what
  each class is. See their pages for more details.
  
  To save some confusion, it's worth pointing out here that C<qr//> is
  B<not> a regular expression (which PPI takes to mean something that
  will actually examine or modify a string), but rather a quote-like
  operator that acts as a constructor for compiled L<Regexp> objects. 
  
  =head1 METHODS
  
  The following methods are inherited by this class' offspring:
  
  =cut
  
  use strict;
  use PPI::Token ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Token';
  }
  
  
  
  
  
  #####################################################################
  # PPI::Token::Regexp Methods
  
  =pod
  
  =head2 get_match_string
  
  The C<get_match_string> method returns the portion of the regexp that
  performs the match.
  
  =cut
  
  sub get_match_string {
  	return $_[0]->_section_content( 0 );
  }
  
  =pod
  
  =head2 get_substitute_string
  
  The C<get_substitute_string> method returns the portion of the regexp
  that is substituted for the match, if any.  If the regexp does not
  substitute, C<undef> is returned.
  
  =cut
  
  sub get_substitute_string {
  	return $_[0]->_section_content( 1 );
  }
  
  =pod
  
  =head2 get_modifiers
  
  The C<get_modifiers> method returns the modifiers of the regexp.
  
  =cut
  
  sub get_modifiers {
  	return $_[0]->_modifiers();
  }
  
  =pod
  
  =head2 get_delimiters
  
  The C<get_delimiters> method returns the delimiters of the regexp as
  an array. The first element is the delimiters of the match string, and
  the second element (if any) is the delimiters of the substitute string
  (if any).
  
  =cut
  
  sub get_delimiters {
  	return $_[0]->_delimiters();
  }
  
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_REGEXP

$fatpacked{"PPI/Token/Regexp/Match.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_REGEXP_MATCH';
  package PPI::Token::Regexp::Match;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::Regexp::Match - A standard pattern match regex
  
  =head1 INHERITANCE
  
    PPI::Token::Regexp::Match
    isa PPI::Token::Regexp
        isa PPI::Token
            isa PPI::Element
  
  =head1 SYNOPSIS
  
    $text =~ m/match regexp/;
    $text =~ /match regexp/;
  
  =head1 DESCRIPTION
  
  A C<PPI::Token::Regexp::Match> object represents a single match regular
  expression. Just to be doubly clear, here are things that are and
  B<aren't> considered a match regexp.
  
    # Is a match regexp
    /This is a match regexp/;
    m/Old McDonald had a farm/eieio;
    
    # These are NOT match regexp
    qr/This is a regexp quote-like operator/;
    s/This is a/replace regexp/;
  
  =head1 METHODS
  
  There are no methods available for C<PPI::Token::Regexp::Match> beyond
  those provided by the parent L<PPI::Token::Regexp>, L<PPI::Token> and
  L<PPI::Element> classes.
  
  Got any ideas for methods? Submit a report to rt.cpan.org!
  
  =cut
  
  use strict;
  use PPI::Token::Regexp             ();
  use PPI::Token::_QuoteEngine::Full ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = qw{
  		PPI::Token::_QuoteEngine::Full
  		PPI::Token::Regexp
  	};
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_REGEXP_MATCH

$fatpacked{"PPI/Token/Regexp/Substitute.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_REGEXP_SUBSTITUTE';
  package PPI::Token::Regexp::Substitute;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::Regexp::Substitute - A match and replace regular expression token
  
  =head1 INHERITANCE
  
    PPI::Token::Regexp::Substitute
    isa PPI::Token::Regexp
        isa PPI::Token
            isa PPI::Element
  
  =head1 SYNOPSIS
  
    $text =~ s/find/$replace/;
  
  =head1 DESCRIPTION
  
  A C<PPI::Token::Regexp::Substitute> object represents a single substitution
  regular expression.
  
  =head1 METHODS
  
  There are no methods available for C<PPI::Token::Regexp::Substitute>
  beyond those provided by the parent L<PPI::Token::Regexp>, L<PPI::Token>
  and L<PPI::Element> classes.
  
  Got any ideas for methods? Submit a report to rt.cpan.org!
  
  =cut
  
  use strict;
  use PPI::Token::Regexp             ();
  use PPI::Token::_QuoteEngine::Full ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = qw{
  		PPI::Token::_QuoteEngine::Full
  		PPI::Token::Regexp
  	};
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_REGEXP_SUBSTITUTE

$fatpacked{"PPI/Token/Regexp/Transliterate.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_REGEXP_TRANSLITERATE';
  package PPI::Token::Regexp::Transliterate;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::Regexp::Transliterate - A transliteration regular expression token
  
  =head1 INHERITANCE
  
    PPI::Token::Regexp::Transliterate
    isa PPI::Token::Regexp
        isa PPI::Token
            isa PPI::Element
  
  =head1 SYNOPSIS
  
    $text =~ tr/abc/xyz/;
  
  =head1 DESCRIPTION
  
  A C<PPI::Token::Regexp::Transliterate> object represents a single
  transliteration regular expression.
  
  I'm afraid you'll have to excuse the ridiculously long class name, but
  when push came to shove I ended up going for pedantically correct
  names for things (practically cut and paste from the various docs).
  
  =head1 METHODS
  
  There are no methods available for C<PPI::Token::Regexp::Transliterate>
  beyond those provided by the parent L<PPI::Token::Regexp>, L<PPI::Token>
  and L<PPI::Element> classes.
  
  Got any ideas for methods? Submit a report to rt.cpan.org!
  
  =cut
  
  use strict;
  use PPI::Token::Regexp             ();
  use PPI::Token::_QuoteEngine::Full ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = qw{
  		PPI::Token::_QuoteEngine::Full
  		PPI::Token::Regexp
  	};
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_REGEXP_TRANSLITERATE

$fatpacked{"PPI/Token/Separator.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_SEPARATOR';
  package PPI::Token::Separator;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::Separator - The __DATA__ and __END__ tags
  
  =head1 INHERITANCE
  
    PPI::Token::Separator
    isa PPI::Token::Word
        isa PPI::Token
            isa PPI::Element
  
  =head1 DESCRIPTION
  
  Although superficially looking like a normal L<PPI::Token::Word> object,
  when the C<__DATA__> and C<__END__> compiler tags appear at the beginning of
  a line (on supposedly) their own line, these tags become file section
  separators.
  
  The indicate that the time for Perl code is over, and the rest of the
  file is dedicated to something else (data in the case of C<__DATA__>) or
  to nothing at all (in the case of C<__END__>).
  
  =head1 METHODS
  
  This class has no methods beyond what is provided by its
  L<PPI::Token::Word>, L<PPI::Token> and L<PPI::Element>
  parent classes.
  
  =cut
  
  use strict;
  use PPI::Token::Word ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Token::Word';
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_SEPARATOR

$fatpacked{"PPI/Token/Structure.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_STRUCTURE';
  package PPI::Token::Structure;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::Structure - Token class for characters that define code structure
  
  =head1 INHERITANCE
  
    PPI::Token::Structure
    isa PPI::Token
        isa PPI::Element
  
  =head1 DESCRIPTION
  
  The C<PPI::Token::Structure> class is used for tokens that control the
  generally tree structure or code.
  
  This consists of seven characters. These are the six brace characters from
  the "round", "curly" and "square" pairs, plus the semi-colon statement
  separator C<;>.
  
  =head1 METHODS
  
  This class has no methods beyond what is provided by its
  L<PPI::Token> and L<PPI::Element> parent classes.
  
  =cut
  
  use strict;
  use PPI::Token ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Token';
  }
  
  # Set the matching braces, done as an array
  # for slightly faster lookups.
  use vars qw{@MATCH @OPENS @CLOSES};
  BEGIN {
  	$MATCH[ord '{']  = '}';
  	$MATCH[ord '}']  = '{';
  	$MATCH[ord '[']  = ']';
  	$MATCH[ord ']']  = '[';
  	$MATCH[ord '(']  = ')';
  	$MATCH[ord ')']  = '(';
  
  	$OPENS[ord '{']  = 1;
  	$OPENS[ord '[']  = 1;
  	$OPENS[ord '(']  = 1;
  
  	$CLOSES[ord '}'] = 1;
  	$CLOSES[ord ']'] = 1;
  	$CLOSES[ord ')'] = 1;
  }
  
  
  
  
  
  #####################################################################
  # Tokenizer Methods
  
  sub __TOKENIZER__on_char {
  	# Structures are one character long, always.
  	# Finalize and process again.
  	$_[1]->_finalize_token->__TOKENIZER__on_char( $_[1] );
  }
  
  sub __TOKENIZER__commit {
  	my $t = $_[1];
  	$t->_new_token( 'Structure', substr( $t->{line}, $t->{line_cursor}, 1 ) );
  	$t->_finalize_token;
  	0;
  }
  
  
  
  
  
  #####################################################################
  # Lexer Methods
  
  # For a given brace, find its opposing pair
  sub __LEXER__opposite {
  	$MATCH[ord $_[0]->{content} ];
  }
  
  
  
  
  
  #####################################################################
  # PPI::Element Methods
  
  # There is a unusual situation in regards to "siblings".
  #
  # As an Element, braces sit outside the normal tree structure, and in
  # this context they NEVER have siblings.
  #
  # However, as tokens they DO have siblings.
  #
  # As such, we need special versions of _all_ of the sibling methods to
  # handle this.
  #
  # Statement terminators do not have these problems, and for them sibling
  # calls work as normal, and so they can just be passed upwards.
  
  sub next_sibling {
  	return $_[0]->SUPER::next_sibling if $_[0]->{content} eq ';';
  	return '';
  }
  
  sub snext_sibling {
  	return $_[0]->SUPER::snext_sibling if $_[0]->{content} eq ';';
  	return '';
  }
  
  sub previous_sibling {
  	return $_[0]->SUPER::previous_sibling if $_[0]->{content} eq ';';
  	return '';
  }
  
  sub sprevious_sibling {
  	return $_[0]->SUPER::sprevious_sibling if $_[0]->{content} eq ';';
  	return '';
  }
  
  sub next_token {
  	my $self = shift;
  	return $self->SUPER::next_token if $self->{content} eq ';';
  	my $structure = $self->parent or return '';
  
  	# If this is an opening brace, descend down into our parent
  	# structure, if it has children.
  	if ( $OPENS[ ord $self->{content} ] ) {
  		my $child = $structure->child(0);
  		if ( $child ) {
  			# Decend deeper, or return if it is a token
  			return $child->isa('PPI::Token') ? $child : $child->first_token;
  		} elsif ( $structure->finish ) {
  			# Empty structure, so next is closing brace
  			return $structure->finish;
  		}
  
  		# Anything that slips through to here is a structure
  		# with an opening brace, but no closing brace, so we
  		# just have to go with it, and continue as we would
  		# if we started with a closing brace.
  	}
  
  	# We can use the default implement, if we call it from the
  	# parent structure of the closing brace.
  	$structure->next_token;
  }
  
  sub previous_token {
  	my $self = shift;
  	return $self->SUPER::previous_token if $self->{content} eq ';';
  	my $structure = $self->parent or return '';
  
  	# If this is a closing brace, descend down into our parent
  	# structure, if it has children.
  	if ( $CLOSES[ ord $self->{content} ] ) {
  		my $child = $structure->child(-1);
  		if ( $child ) {
  			# Decend deeper, or return if it is a token
  			return $child->isa('PPI::Token') ? $child : $child->last_token;
  		} elsif ( $structure->start ) {
  			# Empty structure, so next is closing brace
  			return $structure->start;
  		}
  
  		# Anything that slips through to here is a structure
  		# with a closing brace, but no opening brace, so we
  		# just have to go with it, and continue as we would
  		# if we started with a opening brace.
  	}
  
  	# We can use the default implement, if we call it from the
  	# parent structure of the closing brace.
  	$structure->previous_token;
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_STRUCTURE

$fatpacked{"PPI/Token/Symbol.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_SYMBOL';
  package PPI::Token::Symbol;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::Symbol - A token class for variables and other symbols
  
  =head1 INHERITANCE
  
    PPI::Token::Symbol
    isa PPI::Token
        isa PPI::Element
  
  =head1 DESCRIPTION
  
  The C<PPI::Token::Symbol> class is used to cover all tokens that represent
  variables and other things that start with a sigil.
  
  =head1 METHODS
  
  This class has several methods beyond what is provided by its
  L<PPI::Token> and L<PPI::Element> parent classes.
  
  Most methods are provided to help work out what the object is actually
  pointing at, rather than what it might appear to be pointing at.
  
  =cut
   
  use strict;
  use Params::Util qw{_INSTANCE};
  use PPI::Token   ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Token';
  }
  
  
  
  
  
  #####################################################################
  # PPI::Token::Symbol Methods
  
  =pod
  
  =head2 canonical
  
  The C<canonical> method returns a normalized, canonical version of the
  symbol.
  
  For example, it converts C<$ ::foo'bar::baz> to C<$main::foo::bar::baz>.
  
  This does not fully resolve the symbol, but merely removes syntax
  variations.
  
  =cut
  
  sub canonical {
  	my $symbol = shift->content;
  	$symbol =~ s/\s+//;
  	$symbol =~ s/(?<=[\$\@\%\&\*])::/main::/;
  	$symbol =~ s/\'/::/g;
  	$symbol;
  }
  
  =pod
  
  =head2 symbol
  
  The C<symbol> method returns the ACTUAL symbol this token refers to.
  
  A token of C<$foo> might actually be referring to C<@foo>, if it is found
  in the form C<$foo[1]>.
  
  This method attempts to resolve these issues to determine the actual
  symbol.
  
  Returns the symbol as a string.
  
  =cut
  
  my %cast_which_trumps_braces = map { $_ => 1 } qw{ $ @ };
  
  sub symbol {
  	my $self   = shift;
  	my $symbol = $self->canonical;
  
  	# Immediately return the cases where it can't be anything else
  	my $type = substr( $symbol, 0, 1 );
  	return $symbol if $type eq '%';
  	return $symbol if $type eq '&';
  
  	# Unless the next significant Element is a structure, it's correct.
  	my $after  = $self->snext_sibling;
  	return $symbol unless _INSTANCE($after, 'PPI::Structure');
  
  	# Process the rest for cases where it might actually be something else
  	my $braces = $after->braces;
  	return $symbol unless defined $braces;
  	if ( $type eq '$' ) {
  
  		# If it is cast to '$' or '@', that trumps any braces
  		my $before = $self->sprevious_sibling;
  		return $symbol if $before &&
  			$before->isa( 'PPI::Token::Cast' ) &&
  			$cast_which_trumps_braces{ $before->content };
  
  		# Otherwise the braces rule
  		substr( $symbol, 0, 1, '@' ) if $braces eq '[]';
  		substr( $symbol, 0, 1, '%' ) if $braces eq '{}';
  
  	} elsif ( $type eq '@' ) {
  		substr( $symbol, 0, 1, '%' ) if $braces eq '{}';
  
  	}
  
  	$symbol;
  }
  
  =pod
  
  =head2 raw_type
  
  The C<raw_type> method returns the B<apparent> type of the symbol in the
  form of its sigil.
  
  Returns the sigil as a string.
  
  =cut
  
  sub raw_type {
  	substr( $_[0]->content, 0, 1 );
  }
  
  =pod
  
  =head2 symbol_type
  
  The C<symbol_type> method returns the B<actual> type of the symbol in the
  form of its sigil.
  
  Returns the sigil as a string.
  
  =cut
  
  sub symbol_type {
  	substr( $_[0]->symbol, 0, 1 );
  }
  
  
  
  
  
  #####################################################################
  # Tokenizer Methods
  
  sub __TOKENIZER__on_char {
  	my $t = $_[1];
  
  	# Suck in till the end of the symbol
  	my $line = substr( $t->{line}, $t->{line_cursor} );
  	if ( $line =~ /^([\w:\']+)/ ) {
  		$t->{token}->{content} .= $1;
  		$t->{line_cursor}      += length $1;
  	}
  
  	# Handle magic things
  	my $content = $t->{token}->{content};	
  	if ( $content eq '@_' or $content eq '$_' ) {
  		$t->{class} = $t->{token}->set_class( 'Magic' );
  		return $t->_finalize_token->__TOKENIZER__on_char( $t );
  	}
  
  	# Shortcut for most of the X:: symbols
  	if ( $content eq '$::' ) {
  		# May well be an alternate form of a Magic
  		my $nextchar = substr( $t->{line}, $t->{line_cursor}, 1 );
  		if ( $nextchar eq '|' ) {
  			$t->{token}->{content} .= $nextchar;
  			$t->{line_cursor}++;
  			$t->{class} = $t->{token}->set_class( 'Magic' );
  		}
  		return $t->_finalize_token->__TOKENIZER__on_char( $t );
  	}
  	if ( $content =~ /^[\$%*@&]::(?:[^\w]|$)/ ) {
  		my $current = substr( $content, 0, 3, '' );
  		$t->{token}->{content} = $current;
  		$t->{line_cursor} -= length( $content );
  		return $t->_finalize_token->__TOKENIZER__on_char( $t );
  	}
  	if ( $content =~ /^(?:\$|\@)\d+/ ) {
  		$t->{class} = $t->{token}->set_class( 'Magic' );
  		return $t->_finalize_token->__TOKENIZER__on_char( $t );
  	}
  
  	# Trim off anything we oversucked...
  	$content =~ /^(
  		[\$@%&*]
  		(?: : (?!:) | # Allow single-colon non-magic vars
  			(?: \w+ | \' (?!\d) \w+ | \:: \w+ )
  			(?:
  				# Allow both :: and ' in namespace separators
  				(?: \' (?!\d) \w+ | \:: \w+ )
  			)*
  			(?: :: )? # Technically a compiler-magic hash, but keep it here
  		)
  	)/x or return undef;
  	unless ( length $1 eq length $content ) {
  		$t->{line_cursor} += length($1) - length($content);
  		$t->{token}->{content} = $1;
  	}
  
  	$t->_finalize_token->__TOKENIZER__on_char( $t );
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_SYMBOL

$fatpacked{"PPI/Token/Unknown.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_UNKNOWN';
  package PPI::Token::Unknown;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::Unknown - Token of unknown or as-yet undetermined type
  
  =head1 INHERITANCE
  
    PPI::Token::Unknown
    isa PPI::Token
        isa PPI::Element
  
  =head1 DESCRIPTION
  
  Object of the type C<PPI::Token::Unknown> exist primarily inside the
  tokenizer, where they are temporarily brought into existing for a very
  short time to represent a token that could be one of a number of types.
  
  Generally, they only exist for a character or two, after which they are
  resolved and converted into the correct type. For an object of this type
  to survive the parsing process is considered a major bug.
  
  Please report any C<PPI::Token::Unknown> you encounter in a L<PPI::Document>
  object as a bug.
  
  =cut
  
  use strict;
  use PPI::Token     ();
  use PPI::Exception ();
  
  use vars qw{$VERSION @ISA $CURLY_SYMBOL};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Token';
  	$CURLY_SYMBOL = qr{^\^[[:upper:]_]\w+\}};
  }
  
  
  
  
  
  #####################################################################
  # Tokenizer Methods
  
  sub __TOKENIZER__on_char {
  	my $t    = $_[1];                                      # Tokenizer object
  	my $c    = $t->{token}->{content};                     # Current token
  	my $char = substr( $t->{line}, $t->{line_cursor}, 1 ); # Current character
  
  	# Now, we split on the different values of the current content
  	if ( $c eq '*' ) {
  		if ( $char =~ /(?:(?!\d)\w|\:)/ ) {
  			# Symbol (unless the thing before it is a number
  			my $tokens = $t->_previous_significant_tokens(1);
  			my $p0     = $tokens->[0];
  			if ( $p0 and ! $p0->isa('PPI::Token::Number') ) {
  				$t->{class} = $t->{token}->set_class( 'Symbol' );
  				return 1;
  			}
  		}
  
  		if ( $char eq '{' ) {
  			# Get rest of line
  			my $rest = substr( $t->{line}, $t->{line_cursor} + 1 );
  			if ( $rest =~ m/$CURLY_SYMBOL/ ) {
  				# control-character symbol (e.g. *{^_Foo})
  				$t->{class} = $t->{token}->set_class( 'Magic' );
  				return 1;
  			} else {
  				# Obvious GLOB cast
  				$t->{class} = $t->{token}->set_class( 'Cast' );
  				return $t->_finalize_token->__TOKENIZER__on_char( $t );
  			}
  		}
  
  		if ( $char eq '$' ) {
  			# Operator/operand-sensitive, multiple or GLOB cast
  			my $_class = undef;
  			my $tokens = $t->_previous_significant_tokens(1);
  			my $p0     = $tokens->[0];
  			if ( $p0 ) {
  				# Is it a token or a number
  				if ( $p0->isa('PPI::Token::Symbol') ) {
  					$_class = 'Operator';
  				} elsif ( $p0->isa('PPI::Token::Number') ) {
  					$_class = 'Operator';
  				} elsif (
  					$p0->isa('PPI::Token::Structure')
  					and
  					$p0->content =~ /^(?:\)|\])$/
  				) {
  					$_class = 'Operator';
  				} else {
  					### This is pretty weak, there's
  					### room for a dozen more tests
  					### before going with a default.
  					### Or even better, a proper
  					### operator/operand method :(
  					$_class = 'Cast';
  				}
  			} else {
  				# Nothing before it, must be glob cast
  				$_class = 'Cast';
  			}
  
  			# Set class and rerun
  			$t->{class} = $t->{token}->set_class( $_class );
  			return $t->_finalize_token->__TOKENIZER__on_char( $t );
  		}
  
  		if ( $char eq '*' || $char eq '=' ) {
  			# Power operator '**' or mult-assign '*='
  			$t->{class} = $t->{token}->set_class( 'Operator' );
  			return 1;
  		}
  
  		$t->{class} = $t->{token}->set_class( 'Operator' );
  		return $t->_finalize_token->__TOKENIZER__on_char( $t );
  
  
  
  	} elsif ( $c eq '$' ) {
  		if ( $char =~ /[a-z_]/i ) {
  			# Symbol
  			$t->{class} = $t->{token}->set_class( 'Symbol' );
  			return 1;
  		}
  
  		if ( $PPI::Token::Magic::magic{ $c . $char } ) {
  			# Magic variable
  			$t->{class} = $t->{token}->set_class( 'Magic' );
  			return 1;
  		}
  
  		if ( $char eq '{' ) {
  			# Get rest of line
  			my $rest = substr( $t->{line}, $t->{line_cursor} + 1 );
  			if ( $rest =~ m/$CURLY_SYMBOL/ ) {
  				# control-character symbol (e.g. ${^MATCH})
  				$t->{class} = $t->{token}->set_class( 'Magic' );
  				return 1;
  			}
  		}
  
  		# Must be a cast
  		$t->{class} = $t->{token}->set_class( 'Cast' );
  		return $t->_finalize_token->__TOKENIZER__on_char( $t );
  
  
  
  	} elsif ( $c eq '@' ) {
  		if ( $char =~ /[\w:]/ ) {
  			# Symbol
  			$t->{class} = $t->{token}->set_class( 'Symbol' );
  			return 1;
  		}
  
  		if ( $PPI::Token::Magic::magic{ $c . $char } ) {
  			# Magic variable
  			$t->{class} = $t->{token}->set_class( 'Magic' );
  			return 1;
  		}
  
  		if ( $char eq '{' ) {
  			# Get rest of line
  			my $rest = substr( $t->{line}, $t->{line_cursor} + 1 );
  			if ( $rest =~ m/$CURLY_SYMBOL/ ) {
  				# control-character symbol (e.g. @{^_Foo})
  				$t->{class} = $t->{token}->set_class( 'Magic' );
  				return 1;
  			}
  		}
  
  		# Must be a cast
  		$t->{class} = $t->{token}->set_class( 'Cast' );
  		return $t->_finalize_token->__TOKENIZER__on_char( $t );
  
  
  
  	} elsif ( $c eq '%' ) {
  		# Is it a number?
  		if ( $char =~ /\d/ ) {
  			# This is %2 (modulus number)
  			$t->{class} = $t->{token}->set_class( 'Operator' );
  			return $t->_finalize_token->__TOKENIZER__on_char( $t );
  		}
  
  		# Is it a magic variable?
  		if ( $char eq '^' || $PPI::Token::Magic::magic{ $c . $char } ) {
  			$t->{class} = $t->{token}->set_class( 'Magic' );
  			return 1;
  		}
  
  		# Is it a symbol?
  		if ( $char =~ /[\w:]/ ) {
  			$t->{class} = $t->{token}->set_class( 'Symbol' );
  			return 1;
  		}
  
  		if ( $char eq '{' ) {
  			# Get rest of line
  			my $rest = substr( $t->{line}, $t->{line_cursor} + 1 );
  			if ( $rest =~ m/$CURLY_SYMBOL/ ) {
  				# control-character symbol (e.g. @{^_Foo})
  				$t->{class} = $t->{token}->set_class( 'Magic' );
  				return 1;
  			}
  		}
  
  		if ( $char =~ /[\$@%*{]/ ) {
  			# It's a cast
  			$t->{class} = $t->{token}->set_class( 'Cast' );
  			return $t->_finalize_token->__TOKENIZER__on_char( $t );
  
  		}
  
  		# Probably the mod operator
  		$t->{class} = $t->{token}->set_class( 'Operator' );
  		return $t->{class}->__TOKENIZER__on_char( $t );
  
  
  
  	} elsif ( $c eq '&' ) {
  		# Is it a number?
  		if ( $char =~ /\d/ ) {
  			# This is &2 (bitwise-and number)
  			$t->{class} = $t->{token}->set_class( 'Operator' );
  			return $t->_finalize_token->__TOKENIZER__on_char( $t );
  		}
  
  		# Is it a symbol
  		if ( $char =~ /[\w:]/ ) {
  			$t->{class} = $t->{token}->set_class( 'Symbol' );
  			return 1;
  		}
  
  		if ( $char =~ /[\$@%{]/ ) {
  			# The ampersand is a cast
  			$t->{class} = $t->{token}->set_class( 'Cast' );
  			return $t->_finalize_token->__TOKENIZER__on_char( $t );
  		}
  
  		# Probably the binary and operator
  		$t->{class} = $t->{token}->set_class( 'Operator' );
  		return $t->{class}->__TOKENIZER__on_char( $t );
  
  
  
  	} elsif ( $c eq '-' ) {
  		if ( $char =~ /\d/o ) {
  			# Number
  			$t->{class} = $t->{token}->set_class( 'Number' );
  			return 1;
  		}
  
  		if ( $char eq '.' ) {
  			# Number::Float
  			$t->{class} = $t->{token}->set_class( 'Number::Float' );
  			return 1;
  		}
  
  		if ( $char =~ /[a-zA-Z]/ ) {
  			$t->{class} = $t->{token}->set_class( 'DashedWord' );
  			return 1;
  		}
  
  		# The numeric negative operator
  		$t->{class} = $t->{token}->set_class( 'Operator' );
  		return $t->{class}->__TOKENIZER__on_char( $t );
  
  
  
  	} elsif ( $c eq ':' ) {
  		if ( $char eq ':' ) {
  			# ::foo style bareword
  			$t->{class} = $t->{token}->set_class( 'Word' );
  			return 1;
  		}
  
  		# Now, : acts very very differently in different contexts.
  		# Mainly, we need to find out if this is a subroutine attribute.
  		# We'll leave a hint in the token to indicate that, if it is.
  		if ( $_[0]->__TOKENIZER__is_an_attribute( $t ) ) {
  			# This : is an attribute indicator
  			$t->{class} = $t->{token}->set_class( 'Operator' );
  			$t->{token}->{_attribute} = 1;
  			return $t->_finalize_token->__TOKENIZER__on_char( $t );
  		}
  
  		# It MIGHT be a label, but its probably the ?: trinary operator
  		$t->{class} = $t->{token}->set_class( 'Operator' );
  		return $t->{class}->__TOKENIZER__on_char( $t );
  	}
  
  	# erm...
  	PPI::Exception->throw('Unknown value in PPI::Token::Unknown token');
  }
  
  # Are we at a location where a ':' would indicate a subroutine attribute
  sub __TOKENIZER__is_an_attribute {
  	my $t      = $_[1]; # Tokenizer object
  	my $tokens = $t->_previous_significant_tokens(3);
  	my $p0     = $tokens->[0];
  
  	# If we just had another attribute, we are also an attribute
  	return 1 if $p0->isa('PPI::Token::Attribute');
  
  	# If we just had a prototype, then we are an attribute
  	return 1 if $p0->isa('PPI::Token::Prototype');
  
  	# Other than that, we would need to have had a bareword
  	return '' unless $p0->isa('PPI::Token::Word');
  
  	# We could be an anonymous subroutine
  	if ( $p0->isa('PPI::Token::Word') and $p0->content eq 'sub' ) {
  		return 1;
  	}
  
  	# Or, we could be a named subroutine
  	my $p1 = $tokens->[1];
  	my $p2 = $tokens->[2];
  	if (
  		$p1->isa('PPI::Token::Word')
  		and
  		$p1->content eq 'sub'
  		and (
  			$p2->isa('PPI::Token::Structure')
  			or (
  				$p2->isa('PPI::Token::Whitespace')
  				and
  				$p2->content eq ''
  			)
  		)
  	) {
  		return 1;
  	}
  
  	# We arn't an attribute
  	'';	
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_UNKNOWN

$fatpacked{"PPI/Token/Whitespace.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_WHITESPACE';
  package PPI::Token::Whitespace;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::Whitespace - Tokens representing ordinary white space
  
  =head1 INHERITANCE
  
    PPI::Token::Whitespace
    isa PPI::Token
        isa PPI::Element
  
  =head1 DESCRIPTION
  
  As a full "round-trip" parser, PPI records every last byte in a
  file and ensure that it is included in the L<PPI::Document> object.
  
  This even includes whitespace. In fact, Perl documents are seen
  as "floating in a sea of whitespace", and thus any document will
  contain vast quantities of C<PPI::Token::Whitespace> objects.
  
  For the most part, you shouldn't notice them. Or at least, you
  shouldn't B<have> to notice them.
  
  This means doing things like consistently using the "S for significant"
  series of L<PPI::Node> and L<PPI::Element> methods to do things.
  
  If you want the nth child element, you should be using C<schild> rather
  than C<child>, and likewise C<snext_sibling>, C<sprevious_sibling>, and
  so on and so forth.
  
  =head1 METHODS
  
  Again, for the most part you should really B<not> need to do anything
  very significant with whitespace.
  
  But there are a couple of convenience methods provided, beyond those
  provided by the parent L<PPI::Token> and L<PPI::Element> classes.
  
  =cut
  
  use strict;
  use Clone      ();
  use PPI::Token ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Token';
  }
  
  =pod
  
  =head2 null
  
  Because L<PPI> sees documents as sitting on a sort of substrate made of
  whitespace, there are a couple of corner cases that get particularly
  nasty if they don't find whitespace in certain places.
  
  Imagine walking down the beach to go into the ocean, and then quite
  unexpectedly falling off the side of the planet. Well it's somewhat
  equivalent to that, including the whole screaming death bit.
  
  The C<null> method is a convenience provided to get some internals
  out of some of these corner cases.
  
  Specifically it create a whitespace token that represents nothing,
  or at least the null string C<''>. It's a handy way to have some
  "whitespace" right where you need it, without having to have any
  actual characters.
  
  =cut
  
  my $null = undef;
  
  sub null {
  	$null ||= $_[0]->new('');
  	Clone::clone($null);
  }
  
  ### XS -> PPI/XS.xs:_PPI_Token_Whitespace__significant 0.900+
  sub significant { '' }
  
  =pod
  
  =head2 tidy
  
  C<tidy> is a convenience method for removing unneeded whitespace.
  
  Specifically, it removes any whitespace from the end of a line.
  
  Note that this B<doesn't> include POD, where you may well need
  to keep certain types of whitespace. The entire POD chunk lives
  in its own L<PPI::Token::Pod> object.
  
  =cut
  
  sub tidy {
  	$_[0]->{content} =~ s/^\s+?(?>\n)//;
  	1;
  }
  
  
  
  
  
  #####################################################################
  # Parsing Methods
  
  # Build the class and commit maps
  use vars qw{ @CLASSMAP @COMMITMAP %MATCHWORD };
  BEGIN {
  	@CLASSMAP  = ();
  	@COMMITMAP = ();
  	foreach (
  		'a' .. 'u', 'w', 'y', 'z', 'A' .. 'Z', '_'
  	) {
  		$COMMITMAP[ord $_] = 'PPI::Token::Word';
  	}
  	foreach ( qw!; [ ] { } )! )       { $COMMITMAP[ord $_] = 'PPI::Token::Structure' }
  	foreach ( 0 .. 9 )                { $CLASSMAP[ord $_]  = 'Number'   }
  	foreach ( qw{= ? | + > . ! ~ ^} ) { $CLASSMAP[ord $_]  = 'Operator' }
  	foreach ( qw{* $ @ & : %} )       { $CLASSMAP[ord $_]  = 'Unknown'  }
  
  	# Miscellaneous remainder
  	$COMMITMAP[ord '#'] = 'PPI::Token::Comment';
  	$COMMITMAP[ord 'v'] = 'PPI::Token::Number::Version';
  	$CLASSMAP[ord ',']  = 'PPI::Token::Operator';
  	$CLASSMAP[ord "'"]  = 'Quote::Single';
  	$CLASSMAP[ord '"']  = 'Quote::Double';
  	$CLASSMAP[ord '`']  = 'QuoteLike::Backtick';
  	$CLASSMAP[ord '\\'] = 'Cast';
  	$CLASSMAP[ord '_']  = 'Word';
  	$CLASSMAP[9]        = 'Whitespace'; # A horizontal tab
  	$CLASSMAP[10]       = 'Whitespace'; # A newline
  	$CLASSMAP[13]       = 'Whitespace'; # A carriage return
  	$CLASSMAP[32]       = 'Whitespace'; # A normal space
  
  	# Words (functions and keywords) after which a following / is
  	# almost certainly going to be a regex
  	%MATCHWORD = map { $_ => 1 } qw{
  		split
  		if
  		unless
  		grep
  		map
  	};
  }
  
  sub __TOKENIZER__on_line_start {
  	my $t    = $_[1];
  	my $line = $t->{line};
  
  	# Can we classify the entire line in one go
  	if ( $line =~ /^\s*$/ ) {
  		# A whitespace line
  		$t->_new_token( 'Whitespace', $line );
  		return 0;
  
  	} elsif ( $line =~ /^\s*#/ ) {
  		# A comment line
  		$t->_new_token( 'Comment', $line );
  		$t->_finalize_token;
  		return 0;
  
  	} elsif ( $line =~ /^=(\w+)/ ) {
  		# A Pod tag... change to pod mode
  		$t->_new_token( 'Pod', $line );
  		if ( $1 eq 'cut' ) {
  			# This is an error, but one we'll ignore
  			# Don't go into Pod mode, since =cut normally
  			# signals the end of Pod mode
  		} else {
  			$t->{class} = 'PPI::Token::Pod';
  		}
  		return 0;
  
  	} elsif ( $line =~ /^use v6\-alpha\;/ ) {
  		# Indicates a Perl 6 block. Make the initial
  		# implementation just suck in the entire rest of the
  		# file.
  		my @perl6 = ();
  		while ( 1 ) {
  			my $line6 = $t->_get_line;
  			last unless defined $line6;
  			push @perl6, $line6;
  		}
  		push @{ $t->{perl6} }, join '', @perl6;
  
  		# We only sucked in the block, we don't actially do
  		# anything to the "use v6..." line. So return as if
  		# we didn't find anything at all.
  		return 1;
  	}
  
  	1;
  }
  
  sub __TOKENIZER__on_char {
  	my $t    = $_[1];
  	my $char = ord substr $t->{line}, $t->{line_cursor}, 1;
  
  	# Do we definately know what something is?
  	return $COMMITMAP[$char]->__TOKENIZER__commit($t) if $COMMITMAP[$char];
  
  	# Handle the simple option first
  	return $CLASSMAP[$char] if $CLASSMAP[$char];
  
  	if ( $char == 40 ) {  # $char eq '('
  		# Finalise any whitespace token...
  		$t->_finalize_token if $t->{token};
  
  		# Is this the beginning of a sub prototype?
  		# We are a sub prototype IF
  		# 1. The previous significant token is a bareword.
  		# 2. The one before that is the word 'sub'.
  		# 3. The one before that is a 'structure'
  
  		# Get the three previous significant tokens
  		my $tokens = $t->_previous_significant_tokens(3);
  		if ( $tokens ) {
  			# A normal subroutine declaration
  			my $p1 = $tokens->[1];
  			my $p2 = $tokens->[2];
  			if (
  				$tokens->[0]->isa('PPI::Token::Word')
  				and
  				$p1->isa('PPI::Token::Word')
  				and
  				$p1->content eq 'sub'
  				and (
  					$p2->isa('PPI::Token::Structure')
  					or (
  						$p2->isa('PPI::Token::Whitespace')
  						and
  						$p2->content eq ''
  					)
  				)
  			) {
  				# This is a sub prototype
  				return 'Prototype';
  			}
  
  			# An prototyped anonymous subroutine
  			my $p0 = $tokens->[0];
  			if ( $p0->isa('PPI::Token::Word') and $p0->content eq 'sub'
  				# Maybe it's invoking a method named 'sub'
  				and not ( $p1 and $p1->isa('PPI::Token::Operator') and $p1->content eq '->')
  			) {
  				return 'Prototype';
  			}
  		}
  
  		# This is a normal open bracket
  		return 'Structure';
  
  	} elsif ( $char == 60 ) { # $char eq '<'
  		# Finalise any whitespace token...
  		$t->_finalize_token if $t->{token};
  
  		# This is either "less than" or "readline quote-like"
  		# Do some context stuff to guess which.
  		my $prev = $t->_last_significant_token;
  
  		# The most common group of less-thans are used like
  		# $foo < $bar
  		# 1 < $bar
  		# $#foo < $bar
  		return 'Operator' if $prev->isa('PPI::Token::Symbol');
  		return 'Operator' if $prev->isa('PPI::Token::Magic');
  		return 'Operator' if $prev->isa('PPI::Token::Number');
  		return 'Operator' if $prev->isa('PPI::Token::ArrayIndex');
  
  		# If it is <<... it's a here-doc instead
  		my $next_char = substr( $t->{line}, $t->{line_cursor} + 1, 1 );
  		if ( $next_char eq '<' ) {
  			return 'Operator';
  		}
  
  		# The most common group of readlines are used like
  		# while ( <...> )
  		# while <>;
  		my $prec = $prev->content;
  		if ( $prev->isa('PPI::Token::Structure') and $prec eq '(' ) {
  			return 'QuoteLike::Readline';
  		}
  		if ( $prev->isa('PPI::Token::Word') and $prec eq 'while' ) {
  			return 'QuoteLike::Readline';
  		}
  		if ( $prev->isa('PPI::Token::Operator') and $prec eq '=' ) {
  			return 'QuoteLike::Readline';
  		}
  		if ( $prev->isa('PPI::Token::Operator') and $prec eq ',' ) {
  			return 'QuoteLike::Readline';
  		}
  
  		if ( $prev->isa('PPI::Token::Structure') and $prec eq '}' ) {
  			# Could go either way... do a regex check
  			# $foo->{bar} < 2;
  			# grep { .. } <foo>;
  			my $line = substr( $t->{line}, $t->{line_cursor} );
  			if ( $line =~ /^<(?!\d)\w+>/ ) {
  				# Almost definitely readline
  				return 'QuoteLike::Readline';
  			}
  		}
  
  		# Otherwise, we guess operator, which has been the default up
  		# until this more comprehensive section was created.
  		return 'Operator';
  
  	} elsif ( $char == 47 ) { #  $char eq '/'
  		# Finalise any whitespace token...
  		$t->_finalize_token if $t->{token};
  
  		# This is either a "divided by" or a "start regex"
  		# Do some context stuff to guess ( ack ) which.
  		# Hopefully the guess will be good enough.
  		my $prev = $t->_last_significant_token;
  		my $prec = $prev->content;
  
  		# Most times following an operator, we are a regex.
  		# This includes cases such as:
  		# ,  - As an argument in a list 
  		# .. - The second condition in a flip flop
  		# =~ - A bound regex
  		# !~ - Ditto
  		return 'Regexp::Match' if $prev->isa('PPI::Token::Operator');
  
  		# After a symbol
  		return 'Operator' if $prev->isa('PPI::Token::Symbol');
  		if ( $prec eq ']' and $prev->isa('PPI::Token::Structure') ) {
  			return 'Operator';
  		}
  
  		# After another number
  		return 'Operator' if $prev->isa('PPI::Token::Number');
  
  		# After going into scope/brackets
  		if (
  			$prev->isa('PPI::Token::Structure')
  			and (
  				$prec eq '('
  				or
  				$prec eq '{'
  				or
  				$prec eq ';'
  			)
  		) {
  			return 'Regexp::Match';
  		}
  
  		# Functions and keywords
  		if (
  			$MATCHWORD{$prec}
  			and
  			$prev->isa('PPI::Token::Word')
  		) {
  			return 'Regexp::Match';
  		}
  
  		# Or as the very first thing in a file
  		return 'Regexp::Match' if $prec eq '';
  
  		# What about the char after the slash? There's some things
  		# that would be highly illogical to see if its an operator.
  		my $next_char = substr $t->{line}, $t->{line_cursor} + 1, 1;
  		if ( defined $next_char and length $next_char ) {
  			if ( $next_char =~ /(?:\^|\[|\\)/ ) {
  				return 'Regexp::Match';
  			}
  		}
  
  		# Otherwise... erm... assume operator?
  		# Add more tests here as potential cases come to light
  		return 'Operator';
  
  	} elsif ( $char == 120 ) { # $char eq 'x'
  		# Handle an arcane special case where "string"x10 means the x is an operator.
  		# String in this case means ::Single, ::Double or ::Execute, or the operator versions or same.
  		my $nextchar = substr $t->{line}, $t->{line_cursor} + 1, 1;
  		my $prev     = $t->_previous_significant_tokens(1);
  		$prev = ref $prev->[0];
  		if ( $nextchar =~ /\d/ and $prev ) {
  			if ( $prev =~ /::Quote::(?:Operator)?(?:Single|Double|Execute)$/ ) {
  				return 'Operator';
  			}
  		}
  
  		# Otherwise, commit like a normal bareword
  		return PPI::Token::Word->__TOKENIZER__commit($t);
  
  	} elsif ( $char == 45 ) { # $char eq '-'
  		# Look for an obvious operator operand context
  		my $context = $t->_opcontext;
  		if ( $context eq 'operator' ) {
  			return 'Operator';
  		} else {
  			# More logic needed
  			return 'Unknown';
  		}
  
  	} elsif ( $char >= 128 ) { # Outside ASCII
  		return 'PPI::Token::Word'->__TOKENIZER__commit($t) if $t =~ /\w/;
  		return 'Whitespace' if $t =~ /\s/;
          }
  
  
  	# All the whitespaces are covered, so what to do
  	### For now, die
  	PPI::Exception->throw("Encountered unexpected character '$char'");
  }
  
  sub __TOKENIZER__on_line_end {
  	$_[1]->_finalize_token if $_[1]->{token};
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_WHITESPACE

$fatpacked{"PPI/Token/Word.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN_WORD';
  package PPI::Token::Word;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::Word - The generic "word" Token
  
  =head1 INHERITANCE
  
    PPI::Token::Word
    isa PPI::Token
        isa PPI::Element
  
  =head1 DESCRIPTION
  
  A C<PPI::Token::Word> object is a PPI-specific representation of several
  different types of word-like things, and is one of the most common Token
  classes found in typical documents.
  
  Specifically, it includes not only barewords, but also any other valid
  Perl identifier including non-operator keywords and core functions, and
  any include C<::> separators inside it, as long as it fits the
  format of a class, function, etc.
  
  =head1 METHODS
  
  There are no methods available for C<PPI::Token::Word> beyond those
  provided by its L<PPI::Token> and L<PPI::Element> parent
  classes.
  
  We expect to add additional methods to help further resolve a Word as
  a function, method, etc over time.  If you need such a thing right
  now, look at L<Perl::Critic::Utils>.
  
  =cut
  
  use strict;
  use PPI::Token ();
  
  use vars qw{$VERSION @ISA %OPERATOR %QUOTELIKE};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Token';
  
  	# Copy in OPERATOR from PPI::Token::Operator
  	*OPERATOR  = *PPI::Token::Operator::OPERATOR;
  
  	%QUOTELIKE = (
  		'q'  => 'Quote::Literal',
  		'qq' => 'Quote::Interpolate',
  		'qx' => 'QuoteLike::Command',
  		'qw' => 'QuoteLike::Words',
  		'qr' => 'QuoteLike::Regexp',
  		'm'  => 'Regexp::Match',
  		's'  => 'Regexp::Substitute',
  		'tr' => 'Regexp::Transliterate',
  		'y'  => 'Regexp::Transliterate',
  	);
  }
  
  =pod
  
  =head2 literal
  
  Returns the value of the Word as a string.  This assumes (often
  incorrectly) that the Word is a bareword and not a function, method,
  keyword, etc.  This differs from C<content> because C<Foo'Bar> expands
  to C<Foo::Bar>.
  
  =begin testing literal 9
  
  my @pairs = (
  	"F",          'F',
  	"Foo::Bar",   'Foo::Bar',
  	"Foo'Bar",    'Foo::Bar',
  );
  while ( @pairs ) {
  	my $from  = shift @pairs;
  	my $to    = shift @pairs;
  	my $doc   = PPI::Document->new( \"$from;" );
  	isa_ok( $doc, 'PPI::Document' );
  	my $word = $doc->find_first('Token::Word');
  	isa_ok( $word, 'PPI::Token::Word' );
  	is( $word->literal, $to, "The source $from becomes $to ok" );
  }
  
  =end testing
  
  =cut
  
  sub literal {
  	my $self = shift;
  	my $word = $self->content;
  
  	# Expand Foo'Bar to Foo::Bar
  	$word =~ s/\'/::/g;
  
  	return $word;
  }
  
  =pod
  
  =head2 method_call
  
  Answers whether this is the name of a method in a method call. Returns true if
  yes, false if no, and nothing if unknown.
  
  =begin testing method_call 24
  
  my $Document = PPI::Document->new(\<<'END_PERL');
  indirect $foo;
  indirect_class_with_colon Foo::;
  $bar->method_with_parentheses;
  print SomeClass->method_without_parentheses + 1;
  sub_call();
  $baz->chained_from->chained_to;
  a_first_thing a_middle_thing a_last_thing;
  (first_list_element, second_list_element, third_list_element);
  first_comma_separated_word, second_comma_separated_word, third_comma_separated_word;
  single_bareword_statement;
  { bareword_no_semicolon_end_of_block }
  $buz{hash_key};
  fat_comma_left_side => $thingy;
  END_PERL
  
  isa_ok( $Document, 'PPI::Document' );
  my $words = $Document->find('Token::Word');
  is( scalar @{$words}, 23, 'Found the 23 test words' );
  my %words = map { $_ => $_ } @{$words};
  is(
  	scalar $words{indirect}->method_call,
  	undef,
  	'Indirect notation is unknown.',
  );
  is(
  	scalar $words{indirect_class_with_colon}->method_call,
  	1,
  	'Indirect notation with following word ending with colons is true.',
  );
  is(
  	scalar $words{method_with_parentheses}->method_call,
  	1,
  	'Method with parentheses is true.',
  );
  is(
  	scalar $words{method_without_parentheses}->method_call,
  	1,
  	'Method without parentheses is true.',
  );
  is(
  	scalar $words{print}->method_call,
  	undef,
  	'Plain print is unknown.',
  );
  is(
  	scalar $words{SomeClass}->method_call,
  	undef,
  	'Class in class method call is unknown.',
  );
  is(
  	scalar $words{sub_call}->method_call,
  	0,
  	'Subroutine call is false.',
  );
  is(
  	scalar $words{chained_from}->method_call,
  	1,
  	'Method that is chained from is true.',
  );
  is(
  	scalar $words{chained_to}->method_call,
  	1,
  	'Method that is chained to is true.',
  );
  is(
  	scalar $words{a_first_thing}->method_call,
  	undef,
  	'First bareword is unknown.',
  );
  is(
  	scalar $words{a_middle_thing}->method_call,
  	undef,
  	'Bareword in the middle is unknown.',
  );
  is(
  	scalar $words{a_last_thing}->method_call,
  	0,
  	'Bareword at the end is false.',
  );
  foreach my $false_word (
  	qw<
  		first_list_element second_list_element third_list_element
  		first_comma_separated_word second_comma_separated_word third_comma_separated_word
  		single_bareword_statement
  		bareword_no_semicolon_end_of_block
  		hash_key
  		fat_comma_left_side
  	>
  ) {
  	is(
  		scalar $words{$false_word}->method_call,
  		0,
  		"$false_word is false.",
  	);
  }
  
  =end testing
  
  =cut
  
  sub method_call {
  	my $self = shift;
  
  	my $previous = $self->sprevious_sibling;
  	if (
  		$previous
  		and
  		$previous->isa('PPI::Token::Operator')
  		and
  		$previous->content eq '->'
  	) {
  		return 1;
  	}
  
  	my $snext = $self->snext_sibling;
  	return 0 unless $snext;
  
  	if (
  		$snext->isa('PPI::Structure::List')
  		or
  		$snext->isa('PPI::Token::Structure')
  		or
  		$snext->isa('PPI::Token::Operator')
  		and (
  			$snext->content eq ','
  			or
  			$snext->content eq '=>'
  		)
  	) {
  		return 0;
  	}
  
  	if (
  		$snext->isa('PPI::Token::Word')
  		and
  		$snext->content =~ m< \w :: \z >xms
  	) {
  		return 1;
  	}
  
  	return;
  }
  
  =begin testing __TOKENIZER__on_char 27
  
  my $Document = PPI::Document->new(\<<'END_PERL');
  $foo eq'bar';
  $foo ne'bar';
  $foo ge'bar';
  $foo le'bar';
  $foo gt'bar';
  $foo lt'bar';
  END_PERL
  
  isa_ok( $Document, 'PPI::Document' );
  my $words = $Document->find('Token::Operator');
  is( scalar @{$words}, 6, 'Found the 6 test operators' );
  
  is( $words->[0], 'eq', q{$foo eq'bar'} );
  is( $words->[1], 'ne', q{$foo ne'bar'} );
  is( $words->[2], 'ge', q{$foo ge'bar'} );
  is( $words->[3], 'le', q{$foo le'bar'} );
  is( $words->[4], 'gt', q{$foo ht'bar'} );
  is( $words->[5], 'lt', q{$foo lt'bar'} );
  
  $Document = PPI::Document->new(\<<'END_PERL');
  q'foo';
  qq'foo';
  END_PERL
  
  isa_ok( $Document, 'PPI::Document' );
  $words = $Document->find('Token::Quote');
  is( scalar @{$words}, 2, 'Found the 2 test quotes' );
  
  is( $words->[0], q{q'foo'}, q{q'foo'} );
  is( $words->[1], q{qq'foo'}, q{qq'foo'} );
  
  $Document = PPI::Document->new(\<<'END_PERL');
  qx'foo';
  qw'foo';
  qr'foo';
  END_PERL
  
  isa_ok( $Document, 'PPI::Document' );
  $words = $Document->find('Token::QuoteLike');
  is( scalar @{$words}, 3, 'Found the 3 test quotelikes' );
  
  is( $words->[0], q{qx'foo'}, q{qx'foo'} );
  is( $words->[1], q{qw'foo'}, q{qw'foo'} );
  is( $words->[2], q{qr'foo'}, q{qr'foo'} );
  
  $Document = PPI::Document->new(\<<'END_PERL');
  m'foo';
  s'foo'bar';
  tr'fo'ba';
  y'fo'ba';
  END_PERL
  
  isa_ok( $Document, 'PPI::Document' );
  $words = $Document->find('Token::Regexp');
  is( scalar @{$words}, 4, 'Found the 4 test quotelikes' );
  
  is( $words->[0], q{m'foo'},     q{m'foo'} );
  is( $words->[1], q{s'foo'bar'}, q{s'foo'bar'} );
  is( $words->[2], q{tr'fo'ba'},  q{tr'fo'ba'} );
  is( $words->[3], q{y'fo'ba'},   q{y'fo'ba'} );
  
  $Document = PPI::Document->new(\<<'END_PERL');
  pack'H*',$data;
  unpack'H*',$data;
  END_PERL
  
  isa_ok( $Document, 'PPI::Document' );
  $words = $Document->find('Token::Word');
  is( scalar @{$words}, 2, 'Found the 2 test words' );
  
  is( $words->[0], 'pack', q{pack'H*',$data} );
  is( $words->[1], 'unpack', q{unpack'H*',$data} );
  
  =end testing
  
  =cut
  
  my %backoff = map { $_ => 1 } qw{
      eq ne ge le gt lt
      q qq qx qw qr m s tr y
      pack unpack
  };
  
  sub __TOKENIZER__on_char {
  	my $class = shift;
  	my $t     = shift;
  
  	# Suck in till the end of the bareword
  	my $rest = substr( $t->{line}, $t->{line_cursor} );
  	if ( $rest =~ /^(\w+(?:(?:\'|::)\w+)*(?:::)?)/ ) {
  		my $word = $1;
  		# Special Case: If we accidentally treat eq'foo' like
  		# the word "eq'foo", then just make 'eq' (or whatever
  		# else is in the %backoff hash.
  		if ( $word =~ /^(\w+)'/ && $backoff{$1} ) {
  		    $word = $1;
  		}
  		$t->{token}->{content} .= $word;
  		$t->{line_cursor} += length $word;
  
  	}
  
  	# We might be a subroutine attribute.
  	my $tokens = $t->_previous_significant_tokens(1);
  	if ( $tokens and $tokens->[0]->{_attribute} ) {
  		$t->{class} = $t->{token}->set_class( 'Attribute' );
  		return $t->{class}->__TOKENIZER__commit( $t );
  	}
  
  	# Check for a quote like operator
  	my $word = $t->{token}->{content};
  	if ( $QUOTELIKE{$word} and ! $class->__TOKENIZER__literal($t, $word, $tokens) ) {
  		$t->{class} = $t->{token}->set_class( $QUOTELIKE{$word} );
  		return $t->{class}->__TOKENIZER__on_char( $t );
  	}
  
  	# Or one of the word operators
  	if ( $OPERATOR{$word} and ! $class->__TOKENIZER__literal($t, $word, $tokens) ) {
  	 	$t->{class} = $t->{token}->set_class( 'Operator' );
   		return $t->_finalize_token->__TOKENIZER__on_char( $t );
  	}
  
  	# Unless this is a simple identifier, at this point
  	# it has to be a normal bareword
  	if ( $word =~ /\:/ ) {
  		return $t->_finalize_token->__TOKENIZER__on_char( $t );
  	}
  
  	# If the NEXT character in the line is a colon, this
  	# is a label.
  	my $char = substr( $t->{line}, $t->{line_cursor}, 1 );
  	if ( $char eq ':' ) {
  		$t->{token}->{content} .= ':';
  		$t->{line_cursor}++;
  		$t->{class} = $t->{token}->set_class( 'Label' );
  
  	# If not a label, '_' on its own is the magic filehandle
  	} elsif ( $word eq '_' ) {
  		$t->{class} = $t->{token}->set_class( 'Magic' );
  
  	}
  
  	# Finalise and process the character again
  	$t->_finalize_token->__TOKENIZER__on_char( $t );
  }
  
  
  
  # We are committed to being a bareword.
  # Or so we would like to believe.
  sub __TOKENIZER__commit {
  	my ($class, $t) = @_;
  
  	# Our current position is the first character of the bareword.
  	# Capture the bareword.
  	my $rest = substr( $t->{line}, $t->{line_cursor} );
  	unless ( $rest =~ /^((?!\d)\w+(?:(?:\'|::)\w+)*(?:::)?)/ ) {
  		# Programmer error
  		die "Fatal error... regex failed to match in '$rest' when expected";
  	}
  
  	# Special Case: If we accidentally treat eq'foo' like the word "eq'foo",
  	# then unwind it and just make it 'eq' (or the other stringy comparitors)
  	my $word = $1;
  	if ( $word =~ /^(\w+)'/ && $backoff{$1} ) {
  	    $word = $1;
  	}
  
  	# Advance the position one after the end of the bareword
  	$t->{line_cursor} += length $word;
  
  	# We might be a subroutine attribute.
  	my $tokens = $t->_previous_significant_tokens(1);
  	if ( $tokens and $tokens->[0]->{_attribute} ) {
  		$t->_new_token( 'Attribute', $word );
  		return ($t->{line_cursor} >= $t->{line_length}) ? 0
  			: $t->{class}->__TOKENIZER__on_char($t);
  	}
  
  	# Check for the end of the file
  	if ( $word eq '__END__' ) {
  		# Create the token for the __END__ itself
  		$t->_new_token( 'Separator', $1 );
  		$t->_finalize_token;
  
  		# Move into the End zone (heh)
  		$t->{zone} = 'PPI::Token::End';
  
  		# Add the rest of the line as a comment, and a whitespace newline
  		# Anything after the __END__ on the line is "ignored". So we must
  		# also ignore it, by turning it into a comment.
  		$rest = substr( $t->{line}, $t->{line_cursor} );
  		$t->{line_cursor} = length $t->{line};
  		if ( $rest =~ /\n$/ ) {
  			chomp $rest;
  			$t->_new_token( 'Comment', $rest ) if length $rest;
  			$t->_new_token( 'Whitespace', "\n" );
  		} else {
  			$t->_new_token( 'Comment', $rest ) if length $rest;
  		}
  		$t->_finalize_token;
  
  		return 0;
  	}
  
  	# Check for the data section
  	if ( $word eq '__DATA__' ) {
  		# Create the token for the __DATA__ itself
  		$t->_new_token( 'Separator', "$1" );
  		$t->_finalize_token;
  
  		# Move into the Data zone
  		$t->{zone} = 'PPI::Token::Data';
  
  		# Add the rest of the line as the Data token
  		$rest = substr( $t->{line}, $t->{line_cursor} );
  		$t->{line_cursor} = length $t->{line};
  		if ( $rest =~ /\n$/ ) {
  			chomp $rest;
  			$t->_new_token( 'Comment', $rest ) if length $rest;
  			$t->_new_token( 'Whitespace', "\n" );
  		} else {
  			$t->_new_token( 'Comment', $rest ) if length $rest;
  		}
  		$t->_finalize_token;
  
  		return 0;
  	}
  
  	my $token_class;
  	if ( $word =~ /\:/ ) {
  		# Since its not a simple identifier...
  		$token_class = 'Word';
  
  	} elsif ( $class->__TOKENIZER__literal($t, $word, $tokens) ) {
  		$token_class = 'Word';
  
  	} elsif ( $QUOTELIKE{$word} ) {
  		# Special Case: A Quote-like operator
  		$t->_new_token( $QUOTELIKE{$word}, $word );
  		return ($t->{line_cursor} >= $t->{line_length}) ? 0
  			: $t->{class}->__TOKENIZER__on_char( $t );
  
  	} elsif ( $OPERATOR{$word} ) {
  		# Word operator
  		$token_class = 'Operator';
  
  	} else {
  		# If the next character is a ':' then its a label...
  		my $string = substr( $t->{line}, $t->{line_cursor} );
  		if ( $string =~ /^(\s*:)(?!:)/ ) {
  			if ( $tokens and $tokens->[0]->{content} eq 'sub' ) {
  				# ... UNLESS its after 'sub' in which
  				# case it is a sub name and an attribute
  				# operator.
  				# We COULD have checked this at the top
  				# level of checks, but this would impose
  				# an additional performance per-word
  				# penalty, and every other case where the
  				# attribute operator doesn't directly
  				# touch the object name already works.
  				$token_class = 'Word';
  			} else {
  				$word .= $1;
  				$t->{line_cursor} += length($1);
  				$token_class = 'Label';
  			}
  		} elsif ( $word eq '_' ) {
  			$token_class = 'Magic';
  		} else {
  			$token_class = 'Word';
  		}
  	}
  
  	# Create the new token and finalise
  	$t->_new_token( $token_class, $word );
  	if ( $t->{line_cursor} >= $t->{line_length} ) {
  		# End of the line
  		$t->_finalize_token;
  		return 0;
  	}
  	$t->_finalize_token->__TOKENIZER__on_char($t);
  }
  
  # Is the word in a "forced" context, and thus cannot be either an
  # operator or a quote-like thing. This version is only useful
  # during tokenization.
  sub __TOKENIZER__literal {
  	my ($class, $t, $word, $tokens) = @_;
  
  	# Is this a forced-word context?
  	# i.e. Would normally be seen as an operator.
  	unless ( $QUOTELIKE{$word} or $PPI::Token::Operator::OPERATOR{$word} ) {
  		return '';
  	}
  
  	# Check the cases when we have previous tokens
  	my $rest = substr( $t->{line}, $t->{line_cursor} );
  	if ( $tokens ) {
  		my $token = $tokens->[0] or return '';
  
  		# We are forced if we are a method name
  		return 1 if $token->{content} eq '->';
  
  		# We are forced if we are a sub name
  		return 1 if $token->isa('PPI::Token::Word') && $token->{content} eq 'sub';
  
  		# If we are contained in a pair of curly braces,
  		# we are probably a bareword hash key
  		if ( $token->{content} eq '{' and $rest =~ /^\s*\}/ ) {
  			return 1;
  		}
  	}
  
  	# In addition, if the word is followed by => it is probably
  	# also actually a word and not a regex.
  	if ( $rest =~ /^\s*=>/ ) {
  		return 1;
  	}
  
  	# Otherwise we probably arn't forced
  	'';
  }
  
  1;
  
  =pod
  
  =head1 TO DO
  
  - Add C<function>, C<method> etc detector methods
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN_WORD

$fatpacked{"PPI/Token/_QuoteEngine.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN__QUOTEENGINE';
  package PPI::Token::_QuoteEngine;
  
  =pod
  
  =head1 NAME
  
  PPI::Token::_QuoteEngine - The PPI Quote Engine
  
  =head1 DESCRIPTION
  
  The C<PPI::Token::_QuoteEngine> package is designed hold functionality
  for processing quotes and quote like operators, including regexes.
  These have special requirements in parsing.
  
  The C<PPI::Token::_QuoteEngine> package itself provides various parsing
  methods, which the L<PPI::Token::Quote>, L<PPI::Token::QuoteLike> and
  L<PPI::Token::Regexp> can inherit from. In this sense, it serves
  as a base class.
  
  =head2 Using this class
  
  I<(Refers only to internal uses. This class does not provide a
  public interface)>
  
  To use these, you should initialize them as normal C<'$Class-E<gt>new'>,
  and then call the 'fill' method, which will cause the specialised
  parser to scan forwards and parse the quote to its end point.
  
  If -E<gt>fill returns true, finalise the token.
  
  =cut
  
  use strict;
  use Carp ();
  
  use vars qw{$VERSION};
  BEGIN {
  	$VERSION = '1.215';
  }
  
  
  
  
  
  # Hook for the __TOKENIZER__on_char token call
  sub __TOKENIZER__on_char {
  	my $class = shift;
  	my $t     = $_[0]->{token} ? shift : return undef;
  
  	# Call the fill method to process the quote
  	my $rv = $t->{token}->_fill( $t );
  	return undef unless defined $rv;
  
  	## Doesn't support "end of file" indicator
  
  	# Finalize the token and return 0 to tell the tokenizer
  	# to go to the next character.
  	$t->_finalize_token;
  
  	0;
  }
  
  
  
  
  
  #####################################################################
  # Optimised character processors, used for quotes
  # and quote like stuff, and accessible to the child classes
  
  # An outright scan, raw and fast.
  # Searches for a particular character, loading in new
  # lines as needed.
  # When called, we start at the current position.
  # When leaving, the position should be set to the position
  # of the character, NOT the one after it.
  sub _scan_for_character {
  	my $class = shift;
  	my $t     = shift;
  	my $char  = (length $_[0] == 1) ? quotemeta shift : return undef;
  
  	# Create the search regex
  	my $search = qr/^(.*?$char)/;
  
  	my $string = '';
  	while ( exists $t->{line} ) {
  		# Get the search area for the current line
  		my $search_area
  			= $t->{line_cursor}
  			? substr( $t->{line}, $t->{line_cursor} )
  			: $t->{line};
  
  		# Can we find a match on this line
  		if ( $search_area =~ /$search/ ) {
  			# Found the character on this line
  			$t->{line_cursor} += length($1) - 1;
  			return $string . $1;
  		}
  
  		# Load in the next line
  		$string .= $search_area;
  		return undef unless defined $t->_fill_line;
  		$t->{line_cursor} = 0;
  	}
  
  	# Returning the string as a reference indicates EOF
  	\$string;
  }
  
  # Scan for a character, but not if it is escaped
  sub _scan_for_unescaped_character {
  	my $class = shift;
  	my $t     = shift;
  	my $char  = (length $_[0] == 1) ? quotemeta shift : return undef;
  
  	# Create the search regex.
  	# Same as above but with a negative look-behind assertion.
  	my $search = qr/^(.*?(?<!\\)(?:\\\\)*$char)/;
  
  	my $string = '';
  	while ( exists $t->{line} ) {
  		# Get the search area for the current line
  		my $search_area
  			= $t->{line_cursor}
  			? substr( $t->{line}, $t->{line_cursor} )
  			: $t->{line};
  
  		# Can we find a match on this line
  		if ( $search_area =~ /$search/ ) {
  			# Found the character on this line
  			$t->{line_cursor} += length($1) - 1;
  			return $string . $1;
  		}
  
  		# Load in the next line
  		$string .= $search_area;
  		my $rv = $t->_fill_line('inscan');
  		if ( $rv ) {
  			# Push to first character
  			$t->{line_cursor} = 0;
  		} elsif ( defined $rv ) {
  			# We hit the End of File
  			return \$string;
  		} else {
  			# Unexpected error
  			return undef;
  		}
  	}
  
  	# We shouldn't be able to get here
  	return undef;
  }
  
  # Scan for a close braced, and take into account both escaping,
  # and open close bracket pairs in the string. When complete, the
  # method leaves the line cursor on the LAST character found.
  sub _scan_for_brace_character {
  	my $class       = shift;
  	my $t           = shift;
  	my $close_brace = $_[0] =~ /^(?:\>|\)|\}|\])$/ ? shift : Carp::confess(''); # return undef;
  	my $open_brace  = $close_brace;
  	$open_brace =~ tr/\>\)\}\]/\<\(\{\[/;
  
  	# Create the search string
  	$close_brace = quotemeta $close_brace;
  	$open_brace = quotemeta $open_brace;
  	my $search = qr/^(.*?(?<!\\)(?:\\\\)*(?:$open_brace|$close_brace))/;
  
  	# Loop as long as we can get new lines
  	my $string = '';
  	my $depth = 1;
  	while ( exists $t->{line} ) {
  		# Get the search area
  		my $search_area
  			= $t->{line_cursor}
  			? substr( $t->{line}, $t->{line_cursor} )
  			: $t->{line};
  
  		# Look for a match
  		unless ( $search_area =~ /$search/ ) {
  			# Load in the next line
  			$string .= $search_area;
  			my $rv = $t->_fill_line('inscan');
  			if ( $rv ) {
  				# Push to first character
  				$t->{line_cursor} = 0;
  				next;
  			}
  			if ( defined $rv ) {
  				# We hit the End of File
  				return \$string;
  			}
  
  			# Unexpected error
  			return undef;
  		}
  
  		# Add to the string
  		$string .= $1;
  		$t->{line_cursor} += length $1;
  
  		# Alter the depth and continue if we arn't at the end
  		$depth += ($1 =~ /$open_brace$/) ? 1 : -1 and next;
  
  		# Rewind the cursor by one character ( cludgy hack )
  		$t->{line_cursor} -= 1;
  		return $string;
  	}
  
  	# Returning the string as a reference indicates EOF
  	\$string;
  }
  
  # Find all spaces and comments, up to, but not including
  # the first non-whitespace character.
  #
  # Although it doesn't return it, it leaves the cursor
  # on the character following the gap
  sub _scan_quote_like_operator_gap {
  	my $t = $_[1];
  
  	my $string = '';
  	while ( exists $t->{line} ) {
  		# Get the search area for the current line
  		my $search_area
  			= $t->{line_cursor}
  			? substr( $t->{line}, $t->{line_cursor} )
  			: $t->{line};
  
  		# Since this regex can match zero characters, it should always match
  		$search_area =~ /^(\s*(?:\#.*)?)/s or return undef;
  
  		# Add the chars found to the string
  		$string .= $1;
  
  		# Did we match the entire line?
  		unless ( length $1 == length $search_area ) {
  			# Partial line match, which means we are at
  			# the end of the gap. Fix the cursor and return
  			# the string.
  			$t->{line_cursor} += length $1;
  			return $string;
  		}
  
  		# Load in the next line.
  		# If we reach the EOF, $t->{line} gets deleted,
  		# which is caught by the while.
  		my $rv = $t->_fill_line('inscan');
  		if ( $rv ) {
  			# Set the cursor to the first character
  			$t->{line_cursor} = 0;
  		} elsif ( defined $rv ) {
  			# Returning the string as a reference indicates EOF
  			return \$string;
  		} else {
  			return undef;
  		}
  	}
  
  	# Shouldn't be able to get here
  	return undef;
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN__QUOTEENGINE

$fatpacked{"PPI/Token/_QuoteEngine/Full.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN__QUOTEENGINE_FULL';
  package PPI::Token::_QuoteEngine::Full;
  
  # Full quote engine
  
  use strict;
  use Clone                    ();
  use Carp                     ();
  use PPI::Token::_QuoteEngine ();
  
  use vars qw{$VERSION @ISA %quotes %sections};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Token::_QuoteEngine';
  
  	# Prototypes for the different braced sections
  	%sections = (
  		'(' => { type => '()', _close => ')' },
  		'<' => { type => '<>', _close => '>' },
  		'[' => { type => '[]', _close => ']' },
  		'{' => { type => '{}', _close => '}' },
  	);
  
  	# For each quote type, the extra fields that should be set.
  	# This should give us faster initialization.
  	%quotes = (
  		'q'   => { operator => 'q',   braced => undef, separator => undef, _sections => 1 },
  		'qq'  => { operator => 'qq',  braced => undef, separator => undef, _sections => 1 },
  		'qx'  => { operator => 'qx',  braced => undef, separator => undef, _sections => 1 },
  		'qw'  => { operator => 'qw',  braced => undef, separator => undef, _sections => 1 },
  		'qr'  => { operator => 'qr',  braced => undef, separator => undef, _sections => 1, modifiers => 1 },
  		'm'   => { operator => 'm',   braced => undef, separator => undef, _sections => 1, modifiers => 1 },
  		's'   => { operator => 's',   braced => undef, separator => undef, _sections => 2, modifiers => 1 },
  		'tr'  => { operator => 'tr',  braced => undef, separator => undef, _sections => 2, modifiers => 1 },
  
  		# Y is the little used varient of tr
  		'y'   => { operator => 'y',   braced => undef, separator => undef, _sections => 2, modifiers => 1 },
  
  		'/'   => { operator => undef, braced => 0,     separator => '/',   _sections => 1, modifiers => 1 },
  
  		# Angle brackets quotes mean "readline(*FILEHANDLE)"
  		'<'   => { operator => undef, braced => 1,     separator => undef, _sections => 1, },
  
  		# The final ( and kind of depreciated ) "first match only" one is not
  		# used yet, since I'm not sure on the context differences between
  		# this and the trinary operator, but its here for completeness.
  		'?'   => { operator => undef, braced => 0,     separator => '?',   _sections => 1, modifiers => 1 },
  	);
  }
  
  =pod
  
  =begin testing new 90
  
  # Verify that Token::Quote, Token::QuoteLike and Token::Regexp
  # do not have ->new functions
  my $RE_SYMBOL  = qr/\A(?!\d)\w+\z/;
  foreach my $name ( qw{Token::Quote Token::QuoteLike Token::Regexp} ) {
  	no strict 'refs';
  	my @functions = sort
  		grep { defined &{"${name}::$_"} }
  		grep { /$RE_SYMBOL/o }
  		keys %{"PPI::${name}::"};
  	is( scalar(grep { $_ eq 'new' } @functions), 0,
  		"$name does not have a new function" );
  }
  
  # This primarily to ensure that qw() with non-balanced types
  # are treated the same as those with balanced types.
  SCOPE: {
  	my @seps   = ( undef, undef, '/', '#', ','  );
  	my @types  = ( '()', '<>', '//', '##', ',,' );
  	my @braced = ( qw{ 1 1 0 0 0 } );
  	my $i      = 0;
  	for my $q ('qw()', 'qw<>', 'qw//', 'qw##', 'qw,,') {
  		my $d = PPI::Document->new(\$q);
  		my $o = $d->{children}->[0]->{children}->[0];
  		my $s = $o->{sections}->[0];
  		is( $o->{operator},  'qw',      "$q correct operator"  );
  		is( $o->{_sections}, 1,         "$q correct _sections" );
  		is( $o->{braced}, $braced[$i],  "$q correct braced"    );
  		is( $o->{separator}, $seps[$i], "$q correct seperator" );
  		is( $o->{content},   $q,        "$q correct content"   );
  		is( $s->{position},  3,         "$q correct position"  );
  		is( $s->{type}, $types[$i],     "$q correct type"      );
  		is( $s->{size},      0,         "$q correct size"      );
  		$i++;
  	}
  }
  
  SCOPE: {
  	my @stuff  = ( qw-( ) < > / / -, '#', '#', ',',',' );
  	my @seps   = ( undef, undef, '/', '#', ','  );
  	my @types  = ( '()', '<>', '//', '##', ',,' );
  	my @braced = ( qw{ 1 1 0 0 0 } );
  	my @secs   = ( qw{ 1 1 0 0 0 } );
  	my $i      = 0;
  	while ( @stuff ) {
  		my $opener = shift @stuff;
  		my $closer = shift @stuff;
  		my $d = PPI::Document->new(\"qw$opener");
  		my $o = $d->{children}->[0]->{children}->[0];
  		my $s = $o->{sections}->[0];
  		is( $o->{operator},  'qw',        "qw$opener correct operator"  );
  		is( $o->{_sections}, $secs[$i],   "qw$opener correct _sections" );
  		is( $o->{braced}, $braced[$i],    "qw$opener correct braced"    );
  		is( $o->{separator}, $seps[$i],   "qw$opener correct seperator" );
  		is( $o->{content},   "qw$opener", "qw$opener correct content"   );
  		if ( $secs[$i] ) {
  			is( $s->{type}, "$opener$closer", "qw$opener correct type"      );
  		}
  		$i++;
  	}
  }
  
  SCOPE: {
  	foreach (
  		[ '/foo/i',       'foo', undef, { i => 1 }, [ '//' ] ],
  		[ 'm<foo>x',      'foo', undef, { x => 1 }, [ '<>' ] ],
  		[ 's{foo}[bar]g', 'foo', 'bar', { g => 1 }, [ '{}', '[]' ] ],
  		[ 'tr/fo/ba/',    'fo',  'ba',  {},         [ '//', '//' ] ],
  		[ 'qr{foo}smx',   'foo', undef, { s => 1, m => 1, x => 1 },
  							    [ '{}' ] ],
  	) {
  		my ( $code, $match, $subst, $mods, $delims ) = @{ $_ };
  		my $doc = PPI::Document->new( \$code );
  		$doc or warn "'$code' did not create a document";
  		my $obj = $doc->child( 0 )->child( 0 );
  		is( $obj->_section_content( 0 ), $match, "$code correct match" );
  		is( $obj->_section_content( 1 ), $subst, "$code correct subst" );
  		is_deeply( { $obj->_modifiers() }, $mods, "$code correct modifiers" );
  		is_deeply( [ $obj->_delimiters() ], $delims, "$code correct delimiters" );
  	}
  }
  
  =end testing
  
  =cut
  
  sub new {
  	my $class = shift;
  	my $init  = defined $_[0]
  		? shift
  		: Carp::croak("::Full->new called without init string");
  
  	# Create the token
  	### This manual SUPER'ing ONLY works because none of
  	### Token::Quote, Token::QuoteLike and Token::Regexp
  	### implement a new function of their own.
  	my $self = PPI::Token::new( $class, $init ) or return undef;
  
  	# Do we have a prototype for the intializer? If so, add the extra fields
  	my $options = $quotes{$init} or return $self->_error(
  		"Unknown quote type '$init'"
  	);
  	foreach ( keys %$options ) {
  		$self->{$_} = $options->{$_};
  	}
  
  	# Set up the modifiers hash if needed
  	$self->{modifiers} = {} if $self->{modifiers};
  
  	# Handle the special < base
  	if ( $init eq '<' ) {
  		$self->{sections}->[0] = Clone::clone( $sections{'<'} );
  	}
  
  	$self;
  }
  
  sub _fill {
  	my $class = shift;
  	my $t     = shift;
  	my $self  = $t->{token}
  		or Carp::croak("::Full->_fill called without current token");
  
  	# Load in the operator stuff if needed
  	if ( $self->{operator} ) {
  		# In an operator based quote-like, handle the gap between the
  		# operator and the opening separator.
  		if ( substr( $t->{line}, $t->{line_cursor}, 1 ) =~ /\s/ ) {
  			# Go past the gap
  			my $gap = $self->_scan_quote_like_operator_gap( $t );
  			return undef unless defined $gap;
  			if ( ref $gap ) {
  				# End of file
  				$self->{content} .= $$gap;
  				return 0;
  			}
  			$self->{content} .= $gap;
  		}
  
  		# The character we are now on is the separator. Capture,
  		# and advance into the first section.
  		my $sep = substr( $t->{line}, $t->{line_cursor}++, 1 );
  		$self->{content} .= $sep;
  
  		# Determine if these are normal or braced type sections
  		if ( my $section = $sections{$sep} ) {
  			$self->{braced}        = 1;
  			$self->{sections}->[0] = Clone::clone($section);
  		} else {
  			$self->{braced}        = 0;
  			$self->{separator}     = $sep;
  		}
  	}
  
  	# Parse different based on whether we are normal or braced
  	my $rv = $self->{braced}
  		? $self->_fill_braced($t)
   		: $self->_fill_normal($t);
  	return $rv if !$rv;
  
  	# Return now unless it has modifiers ( i.e. s/foo//eieio )
  	return 1 unless $self->{modifiers};
  
  	# Check for modifiers
  	my $char;
  	my $len = 0;
  	while ( ($char = substr( $t->{line}, $t->{line_cursor} + 1, 1 )) =~ /[^\W\d_]/ ) {
  		$len++;
  		$self->{content} .= $char;
  		$self->{modifiers}->{lc $char} = 1;
  		$t->{line_cursor}++;
  	}
  }
  
  # Handle the content parsing path for normally seperated
  sub _fill_normal {
  	my $self = shift;
  	my $t    = shift;
  
  	# Get the content up to the next separator
  	my $string = $self->_scan_for_unescaped_character( $t, $self->{separator} );
  	return undef unless defined $string;
  	if ( ref $string ) {
  		# End of file
  		$self->{content} .= $$string;
  		if ( length($$string) > 1 )  {
  			# Complete the properties for the first section
  			my $str = $$string;
  			chop $str;
  			$self->{sections}->[0] = {
  				position => length($self->{content}),
  				size     => length($string),
  				type     => "$self->{separator}$self->{separator}",
  			};
  		} else {
  			# No sections at all
  			$self->{_sections} = 0;
  		}
  		return 0;
  	}
  
  	# Complete the properties of the first section
  	$self->{sections}->[0] = {
  		position => length $self->{content},
  		size     => length($string) - 1,
  		type     => "$self->{separator}$self->{separator}",
  	};
  	$self->{content} .= $string;
  
  	# We are done if there is only one section
  	return 1 if $self->{_sections} == 1;
  
  	# There are two sections.
  
  	# Advance into the next section
  	$t->{line_cursor}++;
  
  	# Get the content up to the end separator
  	$string = $self->_scan_for_unescaped_character( $t, $self->{separator} );
  	return undef unless defined $string;
  	if ( ref $string ) {
  		# End of file
  		$self->{content} .= $$string;
  		return 0;
  	}
  
  	# Complete the properties of the second section
  	$self->{sections}->[1] = {
  		position => length($self->{content}),
  		size     => length($string) - 1
  	};
  	$self->{content} .= $string;
  
  	1;
  }
  
  # Handle content parsing for matching crace seperated
  sub _fill_braced {
  	my $self = shift;
  	my $t    = shift;
  
  	# Get the content up to the close character
  	my $section   = $self->{sections}->[0];
  	my $brace_str = $self->_scan_for_brace_character( $t, $section->{_close} );
  	return undef unless defined $brace_str;
  	if ( ref $brace_str ) {
  		# End of file
  		$self->{content} .= $$brace_str;
  		return 0;
  	}
  
  	# Complete the properties of the first section
  	$section->{position} = length $self->{content};
  	$section->{size}     = length($brace_str) - 1;
  	$self->{content} .= $brace_str;
  	delete $section->{_close};
  
  	# We are done if there is only one section
  	return 1 if $self->{_sections} == 1;
  
  	# There are two sections.
  
  	# Is there a gap between the sections.
  	my $char = substr( $t->{line}, ++$t->{line_cursor}, 1 );
  	if ( $char =~ /\s/ ) {
  		# Go past the gap
  		my $gap_str = $self->_scan_quote_like_operator_gap( $t );
  		return undef unless defined $gap_str;
  		if ( ref $gap_str ) {
  			# End of file
  			$self->{content} .= $$gap_str;
  			return 0;
  		}
  		$self->{content} .= $gap_str;
  		$char = substr( $t->{line}, $t->{line_cursor}, 1 );
  	}
  
  	$section = $sections{$char};
  
  	if ( $section ) {
  		# It's a brace
  
  		# Initialize the second section
  		$self->{content} .= $char;
  		$section = $self->{sections}->[1] = { %$section };
  
  		# Advance into the second region
  		$t->{line_cursor}++;
  		$section->{position} = length($self->{content});
  		$section->{size}     = 0;
  
  		# Get the content up to the close character
  		$brace_str = $self->_scan_for_brace_character( $t, $section->{_close} );
  		return undef unless defined $brace_str;
  		if ( ref $brace_str ) {
  			# End of file
  			$self->{content} .= $$brace_str;
  			$section->{size} = length($$brace_str);
  			delete $section->{_close};
  			return 0;
  		} else {
  			# Complete the properties for the second section
  			$self->{content} .= $brace_str;
  			$section->{size} = length($brace_str) - 1;
  			delete $section->{_close};
  		}
  	} elsif ( $char =~ m/ \A [^\w\s] \z /smx ) {
  		# It is some other delimiter (weird, but possible)
  
  		# Add the delimiter to the content.
  		$self->{content} .= $char;
  
  		# Advance into the next section
  		$t->{line_cursor}++;
  
  		# Get the content up to the end separator
  		my $string = $self->_scan_for_unescaped_character( $t, $char );
  		return undef unless defined $string;
  		if ( ref $string ) {
  			# End of file
  			$self->{content} .= $$string;
  			return 0;
  		}
  
  		# Complete the properties of the second section
  		$self->{sections}->[1] = {
  			position => length($self->{content}),
  			size     => length($string) - 1,
  			type     => "$char$char", 
  		};
  		$self->{content} .= $string;
  
  	} else {
  
  		# Error, it has to be a delimiter of some sort.
  		# Although this will result in a REALLY illegal regexp,
  		# we allow it anyway.
  
  		# Create a null second section
  		$self->{sections}->[1] = {
  			position => length($self->{content}),
  			size     => 0,
  			type     => '',
  		};
  
  		# Attach an error to the token and move on
  		$self->{_error} = "No second section of regexp, or does not start with a balanced character";
  
  		# Roll back the cursor one char and return signalling end of regexp
  		$t->{line_cursor}--;
  		return 0;
  	}
  
  	1;
  }
  
  
  
  
  
  #####################################################################
  # Additional methods to find out about the quote
  
  # In a scalar context, get the number of sections
  # In an array context, get the section information
  sub _sections { wantarray ? @{$_[0]->{sections}} : scalar @{$_[0]->{sections}} }
  
  # Get a section's content
  sub _section_content {
  	my ( $self, $inx ) = @_;
  	$self->{sections} or return;
  	my $sect = $self->{sections}[$inx] or return;
  	return substr $self->content(), $sect->{position}, $sect->{size};
  }
  
  # Get the modifiers if any.
  # In list context, return the modifier hash.
  # In scalar context, clone the hash and return a reference to it.
  # If there are no modifiers, simply return.
  sub _modifiers {
  	my ( $self ) = @_;
  	$self->{modifiers} or return;
  	wantarray and return %{ $self->{modifiers} };
  	return +{ %{ $self->{modifiers} } };
  }
  
  # Get the delimiters, or at least give it a good try to get them.
  sub _delimiters {
  	my ( $self ) = @_;
  	$self->{sections} or return;
  	my @delims;
  	foreach my $sect ( @{ $self->{sections} } ) {
  		if ( exists $sect->{type} ) {
  			push @delims, $sect->{type};
  		} else {
  			my $content = $self->content();
  			push @delims,
  			substr( $content, $sect->{position} - 1, 1 ) .
  			substr( $content, $sect->{position} + $sect->{size}, 1 );
  		}
  	}
  	return @delims;
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN__QUOTEENGINE_FULL

$fatpacked{"PPI/Token/_QuoteEngine/Simple.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKEN__QUOTEENGINE_SIMPLE';
  package PPI::Token::_QuoteEngine::Simple;
  
  # Simple quote engine
  
  use strict;
  use PPI::Token::_QuoteEngine ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '1.215';
  	@ISA     = 'PPI::Token::_QuoteEngine';
  }
  
  sub new {
  	my $class     = shift;
  	my $separator = shift or return undef;
  
  	# Create a new token containing the separator
  	### This manual SUPER'ing ONLY works because none of
  	### Token::Quote, Token::QuoteLike and Token::Regexp
  	### implement a new function of their own.
  	my $self = PPI::Token::new( $class, $separator ) or return undef;
  	$self->{separator} = $separator;
  
  	$self;
  }
  
  sub _fill {
  	my $class = shift;
  	my $t     = shift;
  	my $self  = $t->{token} or return undef;
  
  	# Scan for the end separator
  	my $string = $self->_scan_for_unescaped_character( $t, $self->{separator} );
  	return undef unless defined $string;
  	if ( ref $string ) {
  		# End of file
  		$self->{content} .= $$string;
  		return 0;
  	} else {
  		# End of string
  		$self->{content} .= $string;
  		return $self;
  	}
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKEN__QUOTEENGINE_SIMPLE

$fatpacked{"PPI/Tokenizer.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TOKENIZER';
  package PPI::Tokenizer;
  
  =pod
  
  =head1 NAME
  
  PPI::Tokenizer - The Perl Document Tokenizer
  
  =head1 SYNOPSIS
  
    # Create a tokenizer for a file, array or string
    $Tokenizer = PPI::Tokenizer->new( 'filename.pl' );
    $Tokenizer = PPI::Tokenizer->new( \@lines       );
    $Tokenizer = PPI::Tokenizer->new( \$source      );
    
    # Return all the tokens for the document
    my $tokens = $Tokenizer->all_tokens;
    
    # Or we can use it as an iterator
    while ( my $Token = $Tokenizer->get_token ) {
    	print "Found token '$Token'\n";
    }
    
    # If we REALLY need to manually nudge the cursor, you
    # can do that to (The lexer needs this ability to do rollbacks)
    $is_incremented = $Tokenizer->increment_cursor;
    $is_decremented = $Tokenizer->decrement_cursor;
  
  =head1 DESCRIPTION
  
  PPI::Tokenizer is the class that provides Tokenizer objects for use in
  breaking strings of Perl source code into Tokens.
  
  By the time you are reading this, you probably need to know a little
  about the difference between how perl parses Perl "code" and how PPI
  parsers Perl "documents".
  
  "perl" itself (the interpreter) uses a heavily modified lex specification
  to specify its parsing logic, maintains several types of state as it
  goes, and incrementally tokenizes, lexes AND EXECUTES at the same time.
  
  In fact, it is provably impossible to use perl's parsing method without
  simultaneously executing code. A formal mathematical proof has been
  published demonstrating the method.
  
  This is where the truism "Only perl can parse Perl" comes from.
  
  PPI uses a completely different approach by abandoning the (impossible)
  ability to parse Perl the same way that the interpreter does, and instead
  parsing the source as a document, using a document structure independantly
  derived from the Perl documentation and approximating the perl interpreter
  interpretation as closely as possible.
  
  It was touch and go for a long time whether we could get it close enough,
  but in the end it turned out that it could be done.
  
  In this approach, the tokenizer C<PPI::Tokenizer> is implemented separately
  from the lexer L<PPI::Lexer>.
  
  The job of C<PPI::Tokenizer> is to take pure source as a string and break it
  up into a stream/set of tokens, and contains most of the "black magic" used
  in PPI. By comparison, the lexer implements a relatively straight forward
  tree structure, and has an implementation that is uncomplicated (compared
  to the insanity in the tokenizer at least).
  
  The Tokenizer uses an immense amount of heuristics, guessing and cruft,
  supported by a very B<VERY> flexible internal API, but fortunately it was
  possible to largely encapsulate the black magic, so there is not a lot that
  gets exposed to people using the C<PPI::Tokenizer> itself.
  
  =head1 METHODS
  
  Despite the incredible complexity, the Tokenizer itself only exposes a
  relatively small number of methods, with most of the complexity implemented
  in private methods.
  
  =cut
  
  # Make sure everything we need is loaded so
  # we don't have to go and load all of PPI.
  use strict;
  use Params::Util    qw{_INSTANCE _SCALAR0 _ARRAY0};
  use List::MoreUtils ();
  use PPI::Util       ();
  use PPI::Element    ();
  use PPI::Token      ();
  use PPI::Exception  ();
  use PPI::Exception::ParserRejection ();
  
  use vars qw{$VERSION};
  BEGIN {
  	$VERSION = '1.215';
  }
  
  
  
  
  
  #####################################################################
  # Creation and Initialization
  
  =pod
  
  =head2 new $file | \@lines | \$source
  
  The main C<new> constructor creates a new Tokenizer object. These
  objects have no configuration parameters, and can only be used once,
  to tokenize a single perl source file.
  
  It takes as argument either a normal scalar containing source code,
  a reference to a scalar containing source code, or a reference to an
  ARRAY containing newline-terminated lines of source code.
  
  Returns a new C<PPI::Tokenizer> object on success, or throws a
  L<PPI::Exception> exception on error.
  
  =cut
  
  sub new {
  	my $class = ref($_[0]) || $_[0];
  
  	# Create the empty tokenizer struct
  	my $self = bless {
  		# Source code
  		source       => undef,
  		source_bytes => undef,
  
  		# Line buffer
  		line         => undef,
  		line_length  => undef,
  		line_cursor  => undef,
  		line_count   => 0,
  
  		# Parse state
  		token        => undef,
  		class        => 'PPI::Token::BOM',
  		zone         => 'PPI::Token::Whitespace',
  
  		# Output token buffer
  		tokens       => [],
  		token_cursor => 0,
  		token_eof    => 0,
  
  		# Perl 6 blocks
  		perl6        => [],
  	}, $class;
  
  	if ( ! defined $_[1] ) {
  		# We weren't given anything
  		PPI::Exception->throw("No source provided to Tokenizer");
  
  	} elsif ( ! ref $_[1] ) {
  		my $source = PPI::Util::_slurp($_[1]);
  		if ( ref $source ) {
  			# Content returned by reference
  			$self->{source} = $$source;
  		} else {
  			# Errors returned as a string
  			return( $source );
  		}
  
  	} elsif ( _SCALAR0($_[1]) ) {
  		$self->{source} = ${$_[1]};
  
  	} elsif ( _ARRAY0($_[1]) ) {
  		$self->{source} = join '', map { "\n" } @{$_[1]};
  
  	} else {
  		# We don't support whatever this is
  		PPI::Exception->throw(ref($_[1]) . " is not supported as a source provider");
  	}
  
  	# We can't handle a null string
  	$self->{source_bytes} = length $self->{source};
  	if ( $self->{source_bytes} > 1048576 ) {
  		# Dammit! It's ALWAYS the "Perl" modules larger than a
  		# meg that seems to blow up the Tokenizer/Lexer.
  		# Nobody actually writes real programs larger than a meg
  		# Perl::Tidy (the largest) is only 800k.
  		# It is always these idiots with massive Data::Dumper
  		# structs or huge RecDescent parser.
  		PPI::Exception::ParserRejection->throw("File is too large");
  
  	} elsif ( $self->{source_bytes} ) {
  		# Split on local newlines
  		$self->{source} =~ s/(?:\015{1,2}\012|\015|\012)/\n/g;
  		$self->{source} = [ split /(?<=\n)/, $self->{source} ];
  
  	} else {
  		$self->{source} = [ ];
  	}
  
  	### EVIL
  	# I'm explaining this earlier than I should so you can understand
  	# why I'm about to do something that looks very strange. There's
  	# a problem with the Tokenizer, in that tokens tend to change
  	# classes as each letter is added, but they don't get allocated
  	# their definite final class until the "end" of the token, the
  	# detection of which occurs in about a hundred different places,
  	# all through various crufty code (that triples the speed).
  	#
  	# However, in general, this does not apply to tokens in which a
  	# whitespace character is valid, such as comments, whitespace and
  	# big strings.
  	#
  	# So what we do is add a space to the end of the source. This
  	# triggers normal "end of token" functionality for all cases. Then,
  	# once the tokenizer hits end of file, it examines the last token to
  	# manually either remove the ' ' token, or chop it off the end of
  	# a longer one in which the space would be valid.
  	if ( List::MoreUtils::any { /^__(?:DATA|END)__\s*$/ } @{$self->{source}} ) {
  		$self->{source_eof_chop} = '';
  	} elsif ( ! defined $self->{source}->[0] ) {
  		$self->{source_eof_chop} = '';
  	} elsif ( $self->{source}->[-1] =~ /\s$/ ) {
  		$self->{source_eof_chop} = '';
  	} else {
  		$self->{source_eof_chop} = 1;
  		$self->{source}->[-1] .= ' ';
  	}
  
  	$self;
  }
  
  
  
  
  
  #####################################################################
  # Main Public Methods
  
  =pod
  
  =head2 get_token
  
  When using the PPI::Tokenizer object as an iterator, the C<get_token>
  method is the primary method that is used. It increments the cursor
  and returns the next Token in the output array.
  
  The actual parsing of the file is done only as-needed, and a line at
  a time. When C<get_token> hits the end of the token array, it will
  cause the parser to pull in the next line and parse it, continuing
  as needed until there are more tokens on the output array that
  get_token can then return.
  
  This means that a number of Tokenizer objects can be created, and
  won't consume significant CPU until you actually begin to pull tokens
  from it.
  
  Return a L<PPI::Token> object on success, C<0> if the Tokenizer had
  reached the end of the file, or C<undef> on error.
  
  =cut
  
  sub get_token {
  	my $self = shift;
  
  	# Shortcut for EOF
  	if ( $self->{token_eof}
  	 and $self->{token_cursor} > scalar @{$self->{tokens}}
  	) {
  		return 0;
  	}
  
  	# Return the next token if we can
  	if ( my $token = $self->{tokens}->[ $self->{token_cursor} ] ) {
  		$self->{token_cursor}++;
  		return $token;
  	}
  
  	my $line_rv;
  
  	# Catch exceptions and return undef, so that we
  	# can start to convert code to exception-based code.
  	my $rv = eval {
  		# No token, we need to get some more
  		while ( $line_rv = $self->_process_next_line ) {
  			# If there is something in the buffer, return it
  			# The defined() prevents a ton of calls to PPI::Util::TRUE
  			if ( defined( my $token = $self->{tokens}->[ $self->{token_cursor} ] ) ) {
  				$self->{token_cursor}++;
  				return $token;
  			}
  		}
  		return undef;
  	};
  	if ( $@ ) {
  		if ( _INSTANCE($@, 'PPI::Exception') ) {
  			$@->throw;
  		} else {
  			my $errstr = $@;
  			$errstr =~ s/^(.*) at line .+$/$1/;
  			PPI::Exception->throw( $errstr );
  		}
  	} elsif ( $rv ) {
  		return $rv;
  	}
  
  	if ( defined $line_rv ) {
  		# End of file, but we can still return things from the buffer
  		if ( my $token = $self->{tokens}->[ $self->{token_cursor} ] ) {
  			$self->{token_cursor}++;
  			return $token;
  		}
  
  		# Set our token end of file flag
  		$self->{token_eof} = 1;
  		return 0;
  	}
  
  	# Error, pass it up to our caller
  	undef;
  }
  
  =pod
  
  =head2 all_tokens
  
  When not being used as an iterator, the C<all_tokens> method tells
  the Tokenizer to parse the entire file and return all of the tokens
  in a single ARRAY reference.
  
  It should be noted that C<all_tokens> does B<NOT> interfere with the
  use of the Tokenizer object as an iterator (does not modify the token
  cursor) and use of the two different mechanisms can be mixed safely.
  
  Returns a reference to an ARRAY of L<PPI::Token> objects on success
  or throws an exception on error.
  
  =cut
  
  sub all_tokens {
  	my $self = shift;
  
  	# Catch exceptions and return undef, so that we
  	# can start to convert code to exception-based code.
  	eval {
  		# Process lines until we get EOF
  		unless ( $self->{token_eof} ) {
  			my $rv;
  			while ( $rv = $self->_process_next_line ) {}
  			unless ( defined $rv ) {
  				PPI::Exception->throw("Error while processing source");
  			}
  
  			# Clean up the end of the tokenizer
  			$self->_clean_eof;
  		}
  	};
  	if ( $@ ) {
  		my $errstr = $@;
  		$errstr =~ s/^(.*) at line .+$/$1/;
  		PPI::Exception->throw( $errstr );
  	}
  
  	# End of file, return a copy of the token array.
  	return [ @{$self->{tokens}} ];
  }
  
  =pod
  
  =head2 increment_cursor
  
  Although exposed as a public method, C<increment_method> is implemented
  for expert use only, when writing lexers or other components that work
  directly on token streams.
  
  It manually increments the token cursor forward through the file, in effect
  "skipping" the next token.
  
  Return true if the cursor is incremented, C<0> if already at the end of
  the file, or C<undef> on error.
  
  =cut
  
  sub increment_cursor {
  	# Do this via the get_token method, which makes sure there
  	# is actually a token there to move to.
  	$_[0]->get_token and 1;
  }
  
  =pod
  
  =head2 decrement_cursor
  
  Although exposed as a public method, C<decrement_method> is implemented
  for expert use only, when writing lexers or other components that work
  directly on token streams.
  
  It manually decrements the token cursor backwards through the file, in
  effect "rolling back" the token stream. And indeed that is what it is
  primarily intended for, when the component that is consuming the token
  stream needs to implement some sort of "roll back" feature in its use
  of the token stream.
  
  Return true if the cursor is decremented, C<0> if already at the
  beginning of the file, or C<undef> on error.
  
  =cut
  
  sub decrement_cursor {
  	my $self = shift;
  
  	# Check for the beginning of the file
  	return 0 unless $self->{token_cursor};
  
  	# Decrement the token cursor
  	$self->{token_eof} = 0;
  	--$self->{token_cursor};
  }
  
  
  
  
  
  #####################################################################
  # Working With Source
  
  # Fetches the next line from the input line buffer
  # Returns undef at EOF.
  sub _get_line {
  	my $self = shift;
  	return undef unless $self->{source}; # EOF hit previously
  
  	# Pull off the next line
  	my $line = shift @{$self->{source}};
  
  	# Flag EOF if we hit it
  	$self->{source} = undef unless defined $line;
  
  	# Return the line (or EOF flag)
  	return $line; # string or undef
  }
  
  # Fetches the next line, ready to process
  # Returns 1 on success
  # Returns 0 on EOF
  sub _fill_line {
  	my $self   = shift;
  	my $inscan = shift;
  
  	# Get the next line
  	my $line = $self->_get_line;
  	unless ( defined $line ) {
  		# End of file
  		unless ( $inscan ) {
  			delete $self->{line};
  			delete $self->{line_cursor};
  			delete $self->{line_length};
  			return 0;
  		}
  
  		# In the scan version, just set the cursor to the end
  		# of the line, and the rest should just cascade out.
  		$self->{line_cursor} = $self->{line_length};
  		return 0;
  	}
  
  	# Populate the appropriate variables
  	$self->{line}        = $line;
  	$self->{line_cursor} = -1;
  	$self->{line_length} = length $line;
  	$self->{line_count}++;
  
  	1;
  }
  
  # Get the current character
  sub _char {
  	my $self = shift;
  	substr( $self->{line}, $self->{line_cursor}, 1 );
  }
  
  
  
  
  
  ####################################################################
  # Per line processing methods
  
  # Processes the next line
  # Returns 1 on success completion
  # Returns 0 if EOF
  # Returns undef on error
  sub _process_next_line {
  	my $self = shift;
  
  	# Fill the line buffer
  	my $rv;
  	unless ( $rv = $self->_fill_line ) {
  		return undef unless defined $rv;
  
  		# End of file, finalize last token
  		$self->_finalize_token;
  		return 0;
  	}
  
  	# Run the __TOKENIZER__on_line_start
  	$rv = $self->{class}->__TOKENIZER__on_line_start( $self );
  	unless ( $rv ) {
  		# If there are no more source lines, then clean up
  		if ( ref $self->{source} eq 'ARRAY' and ! @{$self->{source}} ) {
  			$self->_clean_eof;
  		}
  
  		# Defined but false means next line
  		return 1 if defined $rv;
  		PPI::Exception->throw("Error at line $self->{line_count}");
  	}
  
  	# If we can't deal with the entire line, process char by char
  	while ( $rv = $self->_process_next_char ) {}
  	unless ( defined $rv ) {
  		PPI::Exception->throw("Error at line $self->{line_count}, character $self->{line_cursor}");
  	}
  
  	# Trigger any action that needs to happen at the end of a line
  	$self->{class}->__TOKENIZER__on_line_end( $self );
  
  	# If there are no more source lines, then clean up
  	unless ( ref($self->{source}) eq 'ARRAY' and @{$self->{source}} ) {
  		return $self->_clean_eof;
  	}
  
  	return 1;
  }
  
  
  
  
  
  #####################################################################
  # Per-character processing methods
  
  # Process on a per-character basis.
  # Note that due the the high number of times this gets
  # called, it has been fairly heavily in-lined, so the code
  # might look a bit ugly and duplicated.
  sub _process_next_char {
  	my $self = shift;
  
  	### FIXME - This checks for a screwed up condition that triggers
  	###         several warnings, amoungst other things.
  	if ( ! defined $self->{line_cursor} or ! defined $self->{line_length} ) {
  		# $DB::single = 1;
  		return undef;
  	}
  
  	# Increment the counter and check for end of line
  	return 0 if ++$self->{line_cursor} >= $self->{line_length};
  
  	# Pass control to the token class
          my $result;
  	unless ( $result = $self->{class}->__TOKENIZER__on_char( $self ) ) {
  		# undef is error. 0 is "Did stuff ourself, you don't have to do anything"
  		return defined $result ? 1 : undef;
  	}
  
  	# We will need the value of the current character
  	my $char = substr( $self->{line}, $self->{line_cursor}, 1 );
  	if ( $result eq '1' ) {
  		# If __TOKENIZER__on_char returns 1, it is signaling that it thinks that
  		# the character is part of it.
  
  		# Add the character
  		if ( defined $self->{token} ) {
  			$self->{token}->{content} .= $char;
  		} else {
  			defined($self->{token} = $self->{class}->new($char)) or return undef;
  		}
  
  		return 1;
  	}
  
  	# We have been provided with the name of a class
  	if ( $self->{class} ne "PPI::Token::$result" ) {
  		# New class
  		$self->_new_token( $result, $char );
  	} elsif ( defined $self->{token} ) {
  		# Same class as current
  		$self->{token}->{content} .= $char;
  	} else {
  		# Same class, but no current
  		defined($self->{token} = $self->{class}->new($char)) or return undef;
  	}
  
  	1;
  }
  
  
  
  
  
  #####################################################################
  # Altering Tokens in Tokenizer
  
  # Finish the end of a token.
  # Returns the resulting parse class as a convenience.
  sub _finalize_token {
  	my $self = shift;
  	return $self->{class} unless defined $self->{token};
  
  	# Add the token to the token buffer
  	push @{ $self->{tokens} }, $self->{token};
  	$self->{token} = undef;
  
  	# Return the parse class to that of the zone we are in
  	$self->{class} = $self->{zone};
  }
  
  # Creates a new token and sets it in the tokenizer
  # The defined() in here prevent a ton of calls to PPI::Util::TRUE
  sub _new_token {
  	my $self = shift;
  	# throw PPI::Exception() unless @_;
  	my $class = substr( $_[0], 0, 12 ) eq 'PPI::Token::'
  		? shift : 'PPI::Token::' . shift;
  
  	# Finalize any existing token
  	$self->_finalize_token if defined $self->{token};
  
  	# Create the new token and update the parse class
  	defined($self->{token} = $class->new($_[0])) or PPI::Exception->throw;
  	$self->{class} = $class;
  
  	1;
  }
  
  # At the end of the file, we need to clean up the results of the erroneous
  # space that we inserted at the beginning of the process.
  sub _clean_eof {
  	my $self = shift;
  
  	# Finish any partially completed token
  	$self->_finalize_token if $self->{token};
  
  	# Find the last token, and if it has no content, kill it.
  	# There appears to be some evidence that such "null tokens" are
  	# somehow getting created accidentally.
  	my $last_token = $self->{tokens}->[ -1 ];
  	unless ( length $last_token->{content} ) {
  		pop @{$self->{tokens}};
  	}
  
  	# Now, if the last character of the last token is a space we added,
  	# chop it off, deleting the token if there's nothing else left.
  	if ( $self->{source_eof_chop} ) {
  		$last_token = $self->{tokens}->[ -1 ];
  		$last_token->{content} =~ s/ $//;
  		unless ( length $last_token->{content} ) {
  			# Popping token
  			pop @{$self->{tokens}};
  		}
  
  		# The hack involving adding an extra space is now reversed, and
  		# now nobody will ever know. The perfect crime!
  		$self->{source_eof_chop} = '';
  	}
  
  	1;
  }
  
  
  
  
  
  #####################################################################
  # Utility Methods
  
  # Context
  sub _last_token {
  	$_[0]->{tokens}->[-1];
  }
  
  sub _last_significant_token {
  	my $self   = shift;
  	my $cursor = $#{ $self->{tokens} };
  	while ( $cursor >= 0 ) {
  		my $token = $self->{tokens}->[$cursor--];
  		return $token if $token->significant;
  	}
  
  	# Nothing...
  	PPI::Token::Whitespace->null;
  }
  
  # Get an array ref of previous significant tokens.
  # Like _last_significant_token except it gets more than just one token
  # Returns array ref on success.
  # Returns 0 on not enough tokens
  sub _previous_significant_tokens {
  	my $self   = shift;
  	my $count  = shift || 1;
  	my $cursor = $#{ $self->{tokens} };
  
  	my ($token, @tokens);
  	while ( $cursor >= 0 ) {
  		$token = $self->{tokens}->[$cursor--];
  		if ( $token->significant ) {
  			push @tokens, $token;
  			return \@tokens if scalar @tokens >= $count;
  		}
  	}
  
  	# Pad with empties
  	foreach ( 1 .. ($count - scalar @tokens) ) {
  		push @tokens, PPI::Token::Whitespace->null;
  	}
  
  	\@tokens;
  }
  
  my %OBVIOUS_CLASS = (
  	'PPI::Token::Symbol'              => 'operator',
  	'PPI::Token::Magic'               => 'operator',
  	'PPI::Token::Number'              => 'operator',
  	'PPI::Token::ArrayIndex'          => 'operator',
  	'PPI::Token::Quote::Double'       => 'operator',
  	'PPI::Token::Quote::Interpolate'  => 'operator',
  	'PPI::Token::Quote::Literal'      => 'operator',
  	'PPI::Token::Quote::Single'       => 'operator',
  	'PPI::Token::QuoteLike::Backtick' => 'operator',
  	'PPI::Token::QuoteLike::Command'  => 'operator',
  	'PPI::Token::QuoteLike::Readline' => 'operator',
  	'PPI::Token::QuoteLike::Regexp'   => 'operator',
  	'PPI::Token::QuoteLike::Words'    => 'operator',
  );
  
  my %OBVIOUS_CONTENT = (
  	'(' => 'operand',
  	'{' => 'operand',
  	'[' => 'operand',
  	';' => 'operand',
  	'}' => 'operator',
  );
  
  # Try to determine operator/operand context, is possible.
  # Returns "operator", "operand", or "" if unknown.
  sub _opcontext {
  	my $self   = shift;
  	my $tokens = $self->_previous_significant_tokens(1);
  	my $p0     = $tokens->[0];
  	my $c0     = ref $p0;
  
  	# Map the obvious cases
  	return $OBVIOUS_CLASS{$c0}   if defined $OBVIOUS_CLASS{$c0};
  	return $OBVIOUS_CONTENT{$p0} if defined $OBVIOUS_CONTENT{$p0};
  
  	# Most of the time after an operator, we are an operand
  	return 'operand' if $p0->isa('PPI::Token::Operator');
  
  	# If there's NOTHING, it's operand
  	return 'operand' if $p0->content eq '';
  
  	# Otherwise, we don't know
  	return ''
  }
  
  1;
  
  =pod
  
  =head1 NOTES
  
  =head2 How the Tokenizer Works
  
  Understanding the Tokenizer is not for the feint-hearted. It is by far
  the most complex and twisty piece of perl I've ever written that is actually
  still built properly and isn't a terrible spaghetti-like mess. In fact, you
  probably want to skip this section.
  
  But if you really want to understand, well then here goes.
  
  =head2 Source Input and Clean Up
  
  The Tokenizer starts by taking source in a variety of forms, sucking it
  all in and merging into one big string, and doing our own internal line
  split, using a "universal line separator" which allows the Tokenizer to
  take source for any platform (and even supports a few known types of
  broken newlines caused by mixed mac/pc/*nix editor screw ups).
  
  The resulting array of lines is used to feed the tokenizer, and is also
  accessed directly by the heredoc-logic to do the line-oriented part of
  here-doc support.
  
  =head2 Doing Things the Old Fashioned Way
  
  Due to the complexity of perl, and after 2 previously aborted parser
  attempts, in the end the tokenizer was fashioned around a line-buffered
  character-by-character method.
  
  That is, the Tokenizer pulls and holds a line at a time into a line buffer,
  and then iterates a cursor along it. At each cursor position, a method is
  called in whatever token class we are currently in, which will examine the
  character at the current position, and handle it.
  
  As the handler methods in the various token classes are called, they
  build up a output token array for the source code.
  
  Various parts of the Tokenizer use look-ahead, arbitrary-distance
  look-behind (although currently the maximum is three significant tokens),
  or both, and various other heuristic guesses.
  
  I've been told it is officially termed a I<"backtracking parser
  with infinite lookaheads">.
  
  =head2 State Variables
  
  Aside from the current line and the character cursor, the Tokenizer
  maintains a number of different state variables.
  
  =over
  
  =item Current Class
  
  The Tokenizer maintains the current token class at all times. Much of the
  time is just going to be the "Whitespace" class, which is what the base of
  a document is. As the tokenizer executes the various character handlers,
  the class changes a lot as it moves a long. In fact, in some instances,
  the character handler may not handle the character directly itself, but
  rather change the "current class" and then hand off to the character
  handler for the new class.
  
  Because of this, and some other things I'll deal with later, the number of
  times the character handlers are called does not in fact have a direct
  relationship to the number of actual characters in the document.
  
  =item Current Zone
  
  Rather than create a class stack to allow for infinitely nested layers of
  classes, the Tokenizer recognises just a single layer.
  
  To put it a different way, in various parts of the file, the Tokenizer will
  recognise different "base" or "substrate" classes. When a Token such as a
  comment or a number is finalised by the tokenizer, it "falls back" to the
  base state.
  
  This allows proper tokenization of special areas such as __DATA__
  and __END__ blocks, which also contain things like comments and POD,
  without allowing the creation of any significant Tokens inside these areas.
  
  For the main part of a document we use L<PPI::Token::Whitespace> for this,
  with the idea being that code is "floating in a sea of whitespace".
  
  =item Current Token
  
  The final main state variable is the "current token". This is the Token
  that is currently being built by the Tokenizer. For certain types, it
  can be manipulated and morphed and change class quite a bit while being
  assembled, as the Tokenizer's understanding of the token content changes.
  
  When the Tokenizer is confident that it has seen the end of the Token, it
  will be "finalized", which adds it to the output token array and resets
  the current class to that of the zone that we are currently in.
  
  I should also note at this point that the "current token" variable is
  optional. The Tokenizer is capable of knowing what class it is currently
  set to, without actually having accumulated any characters in the Token.
  
  =back
  
  =head2 Making It Faster
  
  As I'm sure you can imagine, calling several different methods for each
  character and running regexes and other complex heuristics made the first
  fully working version of the tokenizer extremely slow.
  
  During testing, I created a metric to measure parsing speed called
  LPGC, or "lines per gigacycle" . A gigacycle is simple a billion CPU
  cycles on a typical single-core CPU, and so a Tokenizer running at
  "1000 lines per gigacycle" should generate around 1200 lines of tokenized
  code when running on a 1200 MHz processor.
  
  The first working version of the tokenizer ran at only 350 LPGC, so to
  tokenize a typical large module such as L<ExtUtils::MakeMaker> took
  10-15 seconds. This sluggishness made it unpractical for many uses.
  
  So in the current parser, there are multiple layers of optimisation
  very carefully built in to the basic. This has brought the tokenizer
  up to a more reasonable 1000 LPGC, at the expense of making the code
  quite a bit twistier.
  
  =head2 Making It Faster - Whole Line Classification
  
  The first step in the optimisation process was to add a hew handler to
  enable several of the more basic classes (whitespace, comments) to be
  able to be parsed a line at a time. At the start of each line, a
  special optional handler (only supported by a few classes) is called to
  check and see if the entire line can be parsed in one go.
  
  This is used mainly to handle things like POD, comments, empty lines,
  and a few other minor special cases.
  
  =head2 Making It Faster - Inlining
  
  The second stage of the optimisation involved inlining a small
  number of critical methods that were repeated an extremely high number
  of times. Profiling suggested that there were about 1,000,000 individual
  method calls per gigacycle, and by cutting these by two thirds a significant
  speed improvement was gained, in the order of about 50%.
  
  You may notice that many methods in the C<PPI::Tokenizer> code look
  very nested and long hand. This is primarily due to this inlining.
  
  At around this time, some statistics code that existed in the early
  versions of the parser was also removed, as it was determined that
  it was consuming around 15% of the CPU for the entire parser, while
  making the core more complicated.
  
  A judgment call was made that with the difficulties likely to be
  encountered with future planned enhancements, and given the relatively
  high cost involved, the statistics features would be removed from the
  Tokenizer.
  
  =head2 Making It Faster - Quote Engine
  
  Once inlining had reached diminishing returns, it became obvious from
  the profiling results that a huge amount of time was being spent
  stepping a char at a time though long, simple and "syntactically boring"
  code such as comments and strings.
  
  The existing regex engine was expanded to also encompass quotes and
  other quote-like things, and a special abstract base class was added
  that provided a number of specialised parsing methods that would "scan
  ahead", looking out ahead to find the end of a string, and updating
  the cursor to leave it in a valid position for the next call.
  
  This is also the point at which the number of character handler calls began
  to greatly differ from the number of characters. But it has been done
  in a way that allows the parser to retain the power of the original
  version at the critical points, while skipping through the "boring bits"
  as needed for additional speed.
  
  The addition of this feature allowed the tokenizer to exceed 1000 LPGC
  for the first time.
  
  =head2 Making It Faster - The "Complete" Mechanism
  
  As it became evident that great speed increases were available by using
  this "skipping ahead" mechanism, a new handler method was added that
  explicitly handles the parsing of an entire token, where the structure
  of the token is relatively simple. Tokens such as symbols fit this case,
  as once we are passed the initial sigil and word char, we know that we
  can skip ahead and "complete" the rest of the token much more easily.
  
  A number of these have been added for most or possibly all of the common
  cases, with most of these "complete" handlers implemented using regular
  expressions.
  
  In fact, so many have been added that at this point, you could arguably
  reclassify the tokenizer as a "hybrid regex, char-by=char heuristic
  tokenizer". More tokens are now consumed in "complete" methods in a
  typical program than are handled by the normal char-by-char methods.
  
  Many of the these complete-handlers were implemented during the writing
  of the Lexer, and this has allowed the full parser to maintain around
  1000 LPGC despite the increasing weight of the Lexer.
  
  =head2 Making It Faster - Porting To C (In Progress)
  
  While it would be extraordinarily difficult to port all of the Tokenizer
  to C, work has started on a L<PPI::XS> "accelerator" package which acts as
  a separate and automatically-detected add-on to the main PPI package.
  
  L<PPI::XS> implements faster versions of a variety of functions scattered
  over the entire PPI codebase, from the Tokenizer Core, Quote Engine, and
  various other places, and implements them identically in XS/C.
  
  In particular, the skip-ahead methods from the Quote Engine would appear
  to be extremely amenable to being done in C, and a number of other
  functions could be cherry-picked one at a time and implemented in C.
  
  Each method is heavily tested to ensure that the functionality is
  identical, and a versioning mechanism is included to ensure that if a
  function gets out of sync, L<PPI::XS> will degrade gracefully and just
  not replace that single method.
  
  =head1 TO DO
  
  - Add an option to reset or seek the token stream...
  
  - Implement more Tokenizer functions in L<PPI::XS>
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TOKENIZER

$fatpacked{"PPI/Transform.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TRANSFORM';
  package PPI::Transform;
  
  =pod
  
  =head1 NAME
  
  PPI::Transform - Abstract base class for document transformation classes
  
  =head1 DESCRIPTION
  
  C<PPI::Transform> provides an API for the creation of classes and objects
  that modify or transform PPI documents.
  
  =head1 METHODS
  
  =cut
  
  use strict;
  use Carp          ();
  use List::Util    ();
  use PPI::Document ();
  use Params::Util  qw{_INSTANCE _CLASS _CODE _SCALAR0};
  
  use vars qw{$VERSION};
  BEGIN {
  	$VERSION = '1.215';
  }
  
  
  
  
  
  #####################################################################
  # Apply Handler Registration
  
  my %HANDLER = ();
  my @ORDER   = ();
  
  # Yes, you can use this yourself.
  # I'm just leaving it undocumented for now.
  sub register_apply_handler {
  	my $class   = shift;
  	my $handler = _CLASS(shift) or Carp::croak("Invalid PPI::Transform->register_apply_handler param");
  	my $get     = _CODE(shift)  or Carp::croak("Invalid PPI::Transform->register_apply_handler param");
  	my $set     = _CODE(shift)  or Carp::croak("Invalid PPI::Transform->register_apply_handler param");
  	if ( $HANDLER{$handler} ) {
  		Carp::croak("PPI::Transform->apply handler '$handler' already exists");
  	}
  
  	# Register the handler
  	$HANDLER{$handler} = [ $get, $set ];
  	unshift @ORDER, $handler;
  }
  
  # Register the default handlers
  __PACKAGE__->register_apply_handler( 'SCALAR', \&_SCALAR_get, \&_SCALAR_set );
  __PACKAGE__->register_apply_handler( 'PPI::Document', sub { $_[0] }, sub { 1 } );
  
  
  
  
  
  #####################################################################
  # Constructor
  
  =pod
  
  =head2 new
  
    my $transform = PPI::Transform->new(
        param1 => 'value1',
        param2 => 'value2',
    );
  
  The C<new> constructor creates a new object for your C<PPI::Transform>
  subclass. A default constructor is provided for you which takes no params
  and creates a basic, empty, object.
  
  If you wish to have your transform constructor take params, these B<must>
  be in the form of a list of key/value pairs.
  
  Returns a new C<PPI::Transform>-compatible object, or returns
  C<undef> on error.
  
  =cut
  
  sub new {
  	my $class = shift;
  	bless { @_ }, $class;
  }
  
  =pod
  
  =head2 document
  
  The C<document> method should be implemented by each subclass, and
  takes a single argument of a L<PPI::Document> object, modifying it
  B<in place> as appropriate for the particular transform class.
  
  That's right, this method B<will not clone> and B<should not clone>
  the document object. If you do not want the original to be modified,
  you need to clone it yourself before passing it in.
  
  Returns the numbers of changes made to the document. If the transform
  is unable to track the quantity (including the situation where it cannot
  tell B<IF> it made a change) it should return 1. Returns zero if no
  changes were made to the document, or C<undef> if an error occurs.
  
  By default this error is likely to only mean that you passed in something
  that wasn't a L<PPI::Document>, but may include additional errors
  depending on the subclass.
  
  =cut
  
  sub document {
  	my $class = shift;
  	die "$class does not implement the required ->document method";
  }
  
  =pod
  
  =head2 apply
  
  The C<apply> method is used to apply the transform to something. The
  argument must be a L<PPI::Document>, or something which can be turned
  into a one and then be written back to again.
  
  Currently, this list is limited to a C<SCALAR> reference, although a
  handler registration process is available for you to add support for
  additional types of object should you wish (see the source for this module).
  
  Returns true if the transform was applied, false if there is an error in the
  transform process, or may die if there is a critical error in the apply
  handler.
  
  =cut
  
  sub apply {
  	my $self = _SELF(shift);
  	my $it   = defined $_[0] ? shift : return undef;
  
  	# Try to find an apply handler
  	my $class = _SCALAR0($it) ? 'SCALAR'
  		: List::Util::first { _INSTANCE($it, $_) } @ORDER
  		or return undef;
  	my $handler = $HANDLER{$class}
  		or die("->apply handler for $class missing! Panic");
  
  	# Get, change, set
  	my $Document = _INSTANCE($handler->[0]->($it), 'PPI::Document')
  		or Carp::croak("->apply handler for $class failed to get a PPI::Document");
  	$self->document( $Document ) or return undef;
  	$handler->[1]->($it, $Document)
  		or Carp::croak("->apply handler for $class failed to save the changed document");
  	1;		
  }
  
  =pod
  
  =head2 file
  
    # Read from one file and write to another
    $transform->file( 'Input.pm' => 'Output.pm' );
    
    # Change a file in place
    $transform->file( 'Change.pm' );
  
  The C<file> method modifies a Perl document by filename. If passed a single
  parameter, it modifies the file in-place. If provided a second parameter,
  it will attempt to save the modified file to the alternative filename.
  
  Returns true on success, or C<undef> on error.
  
  =cut
  
  sub file {
  	my $self = _SELF(shift);
  
  	# Where do we read from and write to
  	my $input  = defined $_[0] ? shift : return undef;
  	my $output = @_ ? defined $_[0] ? "$_[0]" : undef : $input or return undef;
  
  	# Process the file
  	my $Document = PPI::Document->new( "$input" ) or return undef;
  	$self->document( $Document )                  or return undef;
  	$Document->save( $output );
  }
  
  
  
  
  
  #####################################################################
  # Apply Hander Methods
  
  sub _SCALAR_get {
  	PPI::Document->new( $_[0] );
  }
  
  sub _SCALAR_set {
  	my $it = shift;
  	$$it = $_[0]->serialize;
  	1;
  }
  
  
  
  
  
  #####################################################################
  # Support Functions
  
  sub _SELF {
  	return shift if ref $_[0];
  	my $self = $_[0]->new or Carp::croak(
  		"Failed to auto-instantiate new $_[0] object"
  	);
  	$self;
  }
  
  1;
  
  =pod
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2001 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TRANSFORM

$fatpacked{"PPI/Transform/UpdateCopyright.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_TRANSFORM_UPDATECOPYRIGHT';
  package PPI::Transform::UpdateCopyright;
  
  =pod
  
  =head1 NAME
  
  PPI::Transform::UpdateCopyright - Demonstration PPI::Transform class
  
  =head1 SYNOPSIS
  
    my $transform = PPI::Transform::UpdateCopyright->new(
        name => 'Adam Kennedy'
    );
    
    $transform->file('Module.pm');
  
  =head1 DESCRIPTION
  
  B<PPI::Transform::UpdateCopyright> provides a demonstration of a typical
  L<PPI::Transform> class.
  
  This class implements a document transform that will take the name of an
  author and update the copyright statement to refer to the current year,
  if it does not already do so.
  
  =head1 METHODS
  
  =cut
  
  use strict;
  use Params::Util   qw{_STRING};
  use PPI::Transform ();
  
  use vars qw{$VERSION};
  BEGIN {
  	$VERSION = '1.215';
  }
  
  
  
  
  
  #####################################################################
  # Constructor and Accessors
  
  =pod
  
  =head2 new
  
    my $transform = PPI::Transform::UpdateCopyright->new(
        name => 'Adam Kennedy'
    );
  
  The C<new> constructor creates a new transform object for a specific
  author. It takes a single C<name> parameter that should be the name
  (or longer string) for the author.
  
  Specifying the name is required to allow the changing of a subset of
  copyright statements that refer to you from a larger set in a file.
  
  =cut
  
  sub new {
  	my $self = shift->SUPER::new(@_);
  
  	# Must provide a name
  	unless ( defined _STRING($self->name) ) {
  		PPI::Exception->throw("Did not provide a valid name param");
  	}
  
  	return $self;
  }
  
  =pod
  
  =head2 name
  
  The C<name> accessor returns the author name that the transform will be
  searching for copyright statements of.
  
  =cut
  
  sub name {
  	$_[0]->{name};
  }
  
  
  
  
  
  #####################################################################
  # Transform
  
  sub document {
  	my $self     = shift;
  	my $document = _INSTANCE(shift, 'PPI::Document') or return undef;
  
  	# Find things to transform
  	my $name     = quotemeta $self->name;
  	my $regexp   = qr/\bcopyright\b.*$name/m;
  	my $elements = $document->find( sub {
  		$_[1]->isa('PPI::Token::Pod') or return '';
  		$_[1]->content =~ $regexp     or return '';
  		return 1;
  	} );
  	return undef unless defined $elements;
  	return 0 unless $elements;
  
  	# Try to transform any elements
  	my $changes = 0;
  	my $change  = sub {
  		my $copyright = shift;
  		my $thisyear  = (localtime time)[5] + 1900;
  		my @year      = $copyright =~ m/(\d{4})/g;
  
  		if ( @year == 1 ) {
  			# Handle the single year format
  			if ( $year[0] == $thisyear ) {
  				# No change
  				return $copyright;
  			} else {
  				# Convert from single year to multiple year
  				$changes++;
  				$copyright =~ s/(\d{4})/$1 - $thisyear/;
  				return $copyright;
  			}
  		}
  
  		if ( @year == 2 ) {
  			# Handle the range format
  			if ( $year[1] == $thisyear ) {
  				# No change
  				return $copyright;
  			} else {
  				# Change the second year to the current one
  				$changes++;
  				$copyright =~ s/$year[1]/$thisyear/;
  				return $copyright;
  			}
  		}
  
  		# huh?
  		die "Invalid or unknown copyright line '$copyright'";
  	};
  
  	# Attempt to transform each element
  	my $pattern = qr/\b(copyright.*\d)({4}(?:\s*-\s*\d{4})?)(.*$name)/mi;
  	foreach my $element ( @$elements ) {
  		$element =~ s/$pattern/$1 . $change->($2) . $2/eg;
  	}
  
  	return $changes;
  }
  
  1;
  
  =pod
  
  =head1 TO DO
  
  - May need to overload some methods to forcefully prevent Document
  objects becoming children of another Node.
  
  =head1 SUPPORT
  
  See the L<support section|PPI/SUPPORT> in the main module.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2009 - 2011 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PPI_TRANSFORM_UPDATECOPYRIGHT

$fatpacked{"PPI/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_UTIL';
  package PPI::Util;
  
  # Provides some common utility functions that can be imported
  
  use strict;
  use Exporter     ();
  use Digest::MD5  ();
  use Params::Util qw{_INSTANCE _SCALAR0 _ARRAY0};
  
  use vars qw{$VERSION @ISA @EXPORT_OK};
  BEGIN {
  	$VERSION   = '1.215';
  	@ISA       = 'Exporter';
  	@EXPORT_OK = qw{_Document _slurp};
  }
  
  # Alarms are used to catch unexpectedly slow and complex documents
  use constant HAVE_ALARM   => !  ( $^O eq 'MSWin32' or $^O eq 'cygwin' );
  
  # 5.8.7 was the first version to resolve the notorious
  # "unicode length caching" bug. See RT #FIXME
  use constant HAVE_UNICODE => !! ( $] >= 5.008007 );
  
  # Common reusable true and false functions
  # This makes it easy to upgrade many places in PPI::XS
  sub TRUE  () { 1  }
  sub FALSE () { '' }
  
  
  
  
  
  #####################################################################
  # Functions
  
  # Allows a sub that takes a L<PPI::Document> to handle the full range
  # of different things, including file names, SCALAR source, etc.
  sub _Document {
  	shift if @_ > 1;
  	return undef unless defined $_[0];
  	require PPI::Document;
  	return PPI::Document->new(shift) unless ref $_[0];
  	return PPI::Document->new(shift) if _SCALAR0($_[0]);
  	return PPI::Document->new(shift) if _ARRAY0($_[0]);
  	return shift if _INSTANCE($_[0], 'PPI::Document');
  	return undef;
  }
  
  # Provide a simple _slurp implementation
  sub _slurp {
  	my $file = shift;
  	local $/ = undef;
  	local *FILE;
  	open( FILE, '<', $file ) or return "open($file) failed: $!";
  	my $source = <FILE>;
  	close( FILE ) or return "close($file) failed: $!";
  	return \$source;
  }
  
  # Provides a version of Digest::MD5's md5hex that explicitly
  # works on the unix-newlined version of the content.
  sub md5hex {
  	my $string = shift;
  	$string =~ s/(?:\015{1,2}\012|\015|\012)/\015/gs;
  	Digest::MD5::md5_hex($string);
  }
  
  # As above but slurps and calculates the id for a file by name
  sub md5hex_file {
  	my $file    = shift;
  	my $content = _slurp($file);
  	return undef unless ref $content;
  	$$content =~ s/(?:\015{1,2}\012|\015|\012)/\n/gs;
  	md5hex($$content);
  }
  
  1;
PPI_UTIL

$fatpacked{"PPI/XSAccessor.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PPI_XSACCESSOR';
  package PPI::XSAccessor;
  
  # This is an experimental prototype, use at your own risk.
  # Provides optional enhancement of PPI with Class::XSAccessor (if installed)
  
  use 5.006;
  use strict;
  use PPI ();
  
  use vars qw{$VERSION};
  BEGIN {
  	$VERSION = '1.215';
  }
  
  
  
  
  
  ######################################################################
  # Replacement Methods
  
  # Packages are implemented here in alphabetical order
  
  package PPI::Document;
  
  use Class::XSAccessor
  	replace => 1,
  	getters => {
  		readonly => 'readonly',
  	},
  	true    => [
  		'scope'
  	];
  
  package PPI::Document::File;
  
  use Class::XSAccessor
  	replace => 1,
  	getters => {
  		filename => 'filename',
  	};
  
  package PPI::Document::Fragment;
  
  use Class::XSAccessor
  	replace => 1,
  	false   => [
  		'scope',
  	];
  
  package PPI::Document::Normalized;
  
  use Class::XSAccessor
  	replace => 1,
  	getters => {
  		'_Document' => 'Document',
  		'version'   => 'version',
  		'functions' => 'functions',
  	};
  
  package PPI::Element;
  
  use Class::XSAccessor
  	replace => 1,
  	true    => [
  		'significant',
  	];
  
  package PPI::Exception;
  
  use Class::XSAccessor
  	replace => 1,
  	getters => {
  		message => 'message',
  	};
  
  package PPI::Node;
  
  use Class::XSAccessor
  	replace => 1,
  	false   => [
  		'scope',
  	];
  
  package PPI::Normal;
  
  use Class::XSAccessor
  	replace => 1,
  	getters => {
  		'layer' => 'layer',
  	};
  
  package PPI::Statement;
  
  use Class::XSAccessor
  	replace => 1,
  	true    => [
  		'__LEXER__normal',
  	];
  
  package PPI::Statement::Compound;
  
  use Class::XSAccessor
  	replace => 1,
  	true    => [
  		'scope',
  	],
  	false   => [
  		'__LEXER__normal',
  	];
  
  package PPI::Statement::Data;
  
  use Class::XSAccessor
  	replace => 1,
  	false   => [
  		'_complete',
  	];
  
  package PPI::Statement::End;
  
  use Class::XSAccessor
  	replace => 1,
  	true    => [
  		'_complete',
  	];
  
  package PPI::Statement::Given;
  
  use Class::XSAccessor
  	replace => 1,
  	true    => [
  		'scope',
  	],
  	false   => [
  		'__LEXER__normal',
  	];
  
  package PPI::Token;
  
  use Class::XSAccessor
  	replace => 1,
  	getters => {
  		content => 'content',
  	},
  	setters => {
  		set_content => 'content',
  	},
  	true => [
  		'__TOKENIZER__on_line_start',
  		'__TOKENIZER__on_line_end',
  	];
  
  1;
PPI_XSACCESSOR

$fatpacked{"Perl/Tags.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERL_TAGS';
  #!/usr/bin/perl
  
  =head1 NAME
  
  Perl::Tags - Generate (possibly exuberant) Ctags style tags for Perl sourcecode
  
  =head1 SYNOPSIS
  
          use Perl::Tags;
          my $naive_tagger = Perl::Tags::Naive->new( max_level=>2 );
          $naive_tagger->process(
              files => ['Foo.pm', 'bar.pl'],
              refresh=>1 
          );
  
          print $naive_tagger; # stringifies to ctags file
  
  Recursively follows C<use> and C<require> statements, up to a maximum
  of C<max_level>.
  
  See also L<bin/perl-tags> for a command-line script.
  
  =head1 USAGE
  
  There are several taggers distributed with this distribution, including:
  
  =over 4
  
  =item L<Perl::Tags::Naive> 
  
  This is a more-or-less straight ripoff, slightly updated, of the original
  pltags code.  This is a "naive" tagger, in that it makes pragmatic assumptions
  about what Perl code usually looks like (e.g. it doesn't actually parse the
  code.)  This is fast, lightweight, and often Good Enough.
  
  This has additional subclasses such as L<Perl::Tags::Naive::Moose> to parse
  Moose declarations, and L<Perl::Tags::Naive::Lib> to parse C<use lib>.
  
  =item L<Perl::Tags::PPI>
  
  Uses the L<PPI> module to do a deeper analysis and parsing of your Perl code.
  This is more accurate, but slower.
  
  =item L<Perl::Tags::Hybrid>
  
  Can run multiple taggers, such as ::Naive and ::PPI, combining the results.
  
  =back
  
  =head1 EXTENDING
  
  Documentation patches are welcome: in the meantime, have a look at
  L<Perl::Tags::Naive> and its subclasses for a simple line-by-line method of
  tagging files.  Alternatively L<Perl::Tags::PPI> uses L<PPI>'s built in
  method of parsing Perl documents.
  
  In general, you will want to override the C<get_tags_for_file> method,
  returning a list of C<Perl::Tags::Tag> objects to be registered.
  
  For recursively checking other modules, return a C<Perl::Tags::Tag::Recurse>
  object, which does I<not> create a new tag in the resulting perltags file,
  but instead processes the next file recursively.
  
  =head1 FEATURES
  
      * Recursive, incremental tagging.
      * parses `use_ok`/`require_ok` line from Test::More
  
  =head1 DEVELOPING WITH Perl::Tags
  
  C<Perl::Tags> is designed to be integrated into your development
  environment.  Here are a few ways to use it:
  
  =head2 With Vim
  
  C<Perl::Tags> was originally designed to be used with vim.  My
  C<~/.vim/ftplugin/perl.vim> contains the following:
  
      setlocal iskeyword+=:  " make tags with :: in them useful
  
      if ! exists("s:defined_functions")
      function s:init_tags()
          perl <<EOF
              use Perl::Tags;
              $naive_tagger = Perl::Tags::Naive->new( max_level=>2 );
                  # only go one level down by default
      EOF
      endfunction
  
      " let vim do the tempfile cleanup and protection
      let s:tagsfile = tempname()
  
      function s:do_tags(filename)
          perl <<EOF
              my $filename = VIM::Eval('a:filename');
  
              $naive_tagger->process(files => $filename, refresh=>1 );
  
              my $tagsfile=VIM::Eval('s:tagsfile');
              VIM::SetOption("tags+=$tagsfile");
  
              # of course, it may not even output, for example, if there's
              # nothing new to process
              $naive_tagger->output( outfile => $tagsfile );
      EOF
      endfunction
  
      call s:init_tags() " only the first time
  
      let s:defined_functions = 1
      endif
  
      call s:do_tags(expand('%'))
  
      augroup perltags
      au!
      autocmd BufRead,BufWritePost *.pm,*.pl call s:do_tags(expand('%'))
      augroup END
  
  Note the following:
  
  =over 4
  
  =item *
  
  You will need to have a vim with perl compiled in it.  Debuntu packages this as
  C<vim-perl>. Alternatively you can compile from source (you'll need Perl + the
  development headers C<libperl-dev>).
  
  =item *
  
  The C<EOF> in the examples has to be at the beginning of the line (the verbatim
  text above has leading whitespace)
  
  =back
  
  =head2 From the Command Line
  
  See the L<bin/perl-tags> script provided.
  
  =head2 From other editors
  
  Any editor that supports ctags should be able to use this output.  Documentation
  and code patches on how to do this are welcome.
  
  =head1 METHODS
  
  =cut
  
  package Perl::Tags;
  
  use strict; use warnings;
  
  use Perl::Tags::Tag;
  use Data::Dumper;
  use File::Spec;
  
  use overload q("") => \&to_string;
  our $VERSION = 0.28;
  
  =head2 C<new>
  
  L<Perl::Tags> is an abstract baseclass.  Use a class such as 
  L<Perl::Tags::Naive> and instantiate it with C<new>.
  
      $naive_tagger = Perl::Tags::Naive->new( max_level=>2 );
  
  Accepts the following parameters
  
      max_level:    levels of "use" statements to descend into, default 2
      do_variables: tag variables?  default 1 (true)
      exts:         use the Exuberant extensions
  
  =cut
  
  sub new {
      my $class = shift;
      my %options = (
          max_level    => 2, # go into next file, but not down the whole tree
          do_variables => 1, 
          @_);
  
      my $self = \%options;
  
      return bless $self, $class;
  }
  
  =head2 C<to_string>
  
  A L<Perl::Tags> object will stringify to a textual representation of a ctags
  file.
  
      print $tagger;
  
  =cut
  
  sub to_string {
      my $self = shift;
      my $tags = $self->{tags} or return '';
      my %tags = %$tags;
  
      my $s; # to test
  
      my @lines;
  
      # the structure is an HoHoA of
      #
      #   {tag_name}
      #       {file_name}
      #           [ tags ]
      #
      #   where the file_name level is to allow us to prioritize tags from
      #   first-included files (on the basis that they may well be the files we
      #   want to see first.
  
      my $ord = $self->{order};
      my @names = sort keys %$tags;
      for (@names) {
          my $files = $tags{$_};
          push @lines, map { @{$files->{$_}} } 
              sort { $ord->{$a} <=> $ord->{$b} } keys %$files;
      }
      return join "\n", @lines;
  }
  
  =head2 C<clean_file>
  
  Delete all tags, but without touching the "order" seen, that way, if the tags
  are recreated, they will remain near the top of the "interestingness" tree
  
  =cut
  
  sub clean_file {
      my ($self, $file) = @_;
      
      my $tags = $self->{tags} or die "Trying to clean '$file', but there's no tags";
      
      for my $name (keys %$tags) {
          delete $tags->{$name}{$file};
      }
      delete $self->{seen}{$file};
      # we don't delete the {order} though
  }
  
  =head2 C<output>
  
  Save the file to disk if it has changed.  (The private C<{is_dirty}> attribute
  is used, as the tags object may be made up incrementally and recursively within
  your IDE.
  
  =cut
  
  sub output {
      my $self = shift;
      my %options = @_;
      my $outfile = $options{outfile} or die "No file to write to";
  
      return unless $self->{is_dirty} || ! -e $outfile;
  
      open (my $OUT, '>', $outfile) or die "Couldn't open $outfile for write: $!";
  	binmode STDOUT, ":encoding(UTF-8)";
      print $OUT $self;
      close $OUT or die "Couldn't close $outfile for write: $!";
  
      $self->{is_dirty} = 0;
  }
  
  =head2 C<process>
  
  Scan one or more Perl file for tags
  
      $tagger->process( 
          files => [ 'Module.pm',  'script.pl' ] 
      );
      $tagger->process(
          files   => 'script.pl',
          refresh => 1,
      );
  
  =cut
  
  sub process {
      my $self = shift;
      my %options = @_;
      my $files = $options{files} || die "No file passed to process";
      my @files = ref $files ? @$files : ($files);
  
      $self->queue( map { 
                            { file=>$_, level=>1, refresh=>$options{refresh} } 
                        } @files);
  
      while (my $file = $self->popqueue) {
          $self->process_item( %options, %$file );
      }
      return 1;
  }
  
  =head2 C<queue>, C<popqueue>
  
  Internal methods managing the processing
  
  =cut
  
  sub queue {
      my $self = shift;
      for (@_) {
          push @{$self->{queue}}, $_ unless $_->{level} > $self->{max_level};
      }
  }
  
  sub popqueue {
      my $self = shift;
      return pop @{$self->{queue}};
  }
  
  =head2 C<process_item>, C<process_file>, C<get_tags_for_file>
  
  Do the heavy lifting for C<process> above.  
  
  Taggers I<must> override the abstract method C<get_tags_for_file>.
  
  =cut
  
  sub process_item {
      my $self = shift;
      my %options = @_;
      my $file  = $options{file} || die "No file passed to proces";
  
      # make filename absolute, (this could become an option if appropriately
      # refactored) but because of my usage (tags_$PID file in /tmp) I need the
      # absolute path anyway, and it prevents the file being included twice under
      # slightly different names (unless you have 2 hardlinked copies, as I do
      # for my .vim/ directory... bah)
  
      $file = File::Spec->rel2abs( $file ) ;
  
      if ($self->{seen}{$file}++) {
          return unless $options{refresh};
          $self->clean_file( $file );
      }
  
      $self->{is_dirty}++; # we haven't yet been written out
  
      $self->{order}{$file} = $self->{curr_order}++ || 0;
  
      $self->{current} = {
          file          => $file,
          package_name  => '',
          has_subs      => 0,
          var_continues => 0,
          level         => $options{level},
      };
  
      $self->process_file( $file );
  
      return $self->{tags};
  }
  
  sub process_file {
      my ($self, $file) = @_;
  
      my @tags = $self->get_tags_for_file( $file );
  
      $self->register( $file, @tags );
  }
  
  sub get_tags_for_file {
      use Carp 'confess';
      confess "Abstract method get_tags_for_file called";
  }
  
  =head2 C<register>
  
  The parsing is done by a number of lightweight objects (parsers) which look for
  subroutine references, variables, module inclusion etc.  When they are
  successful, they call the C<register> method in the main tags object.
  
  Note that if your tagger wants to register not a new I<declaration> but rather
  a I<usage> of another module, then your tagger should return a
  C<Perl::Tags::Tag::Recurse> object.  This is a pseudo-tag which causes the linked
  module to be scanned in turn.  See L<Perl::Tags::Naive>'s handling of C<use>
  statements as an example!
  
  =cut
  
  sub register {
      my ($self, $file, @tags) = @_;
      for my $tag (@tags) {
          $tag->on_register( $self ) or next;
          $tag->{pkg} ||=  $self->{current}{package_name};
          $tag->{exts} ||= $self->{exts};
  
          # and copy absolute file if requested
          # $tag->{file} = $file if $self->{absolute};
  
          my $name = $tag->{name};
          push @{ $self->{tags}{$name}{$file} }, $tag;
      }
  }
  
  ##
  1;
  
  =head1 SEE ALSO
  
  L<bin/perl-tags>
  
  =head1 CONTRIBUTIONS
  
  Contributions are always welcome.  The repo is in git:
  
      http://github.com/osfameron/perl-tags
  
  Please fork and make pull request.  Maint bits available on request.
  
  =over 4
  
  =item wolverian
  
  ::PPI subclass
  
  =item Ian Tegebo
  
  patch to use File::Temp
  
  =item DMITRI
  
  patch to parse constant and label declarations
  
  =item drbean
  
  ::Naive::Moose, ::Naive::Spiffy and ::Naive::Lib subclasses
  
  =item Alias
  
  prodding me to make repo public
  
  =item nothingmuch
  
  ::PPI fixes
  
  =item tsee
  
  Command line interface, applying patches
  
  =back
  
  =head1 AUTHOR and LICENSE
  
      osfameron (2006-2009) - osfameron@cpan.org
                              and contributors, as above
  
  For support, try emailing me or grabbing me on irc #london.pm on irc.perl.org
  
  This was originally ripped off pltags.pl, as distributed with vim
  and available from L<http://www.mscha.com/mscha.html?pltags#tools>
  Version 2.3, 28 February 2002
  Written by Michael Schaap <pltags@mscha.com>. 
  
  This is licensed under the same terms as Perl itself.  (Or as Vim if you prefer).
  
  =cut
PERL_TAGS

$fatpacked{"Perl/Tags/Hybrid.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERL_TAGS_HYBRID';
  package Perl::Tags::Hybrid;
  
  use strict; use warnings;
  use parent 'Perl::Tags';
  
  =head1 C<Perl::Tags::Hybrid>
  
  Combine the results of multiple parsers, for example C<Perl::Tags::Naive>
  and C<Perl::Tags::PPI>.
  
  =head1 SYNOPSIS
  
      my $parser = Perl::Tags::Hybrid->new(
          taggers => [
              Perl::Tags::Naive->new,
              Perl::Tags::PPI->new,
          ],
      );
  
  =head2 C<get_tags_for_file>
  
  Registers the results from running each sub-taggers
  
  =cut
  
  sub get_taggers {
      my $self = shift;
      return @{ $self->{taggers} || [] };
  }
  
  sub get_tags_for_file {
      my ($self, $file) = @_;
  
      my @taggers = $self->get_taggers;
  
      return map { $_->get_tags_for_file( $file ) } @taggers;
  }
  
  1;
PERL_TAGS_HYBRID

$fatpacked{"Perl/Tags/Naive.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERL_TAGS_NAIVE';
  package Perl::Tags::Naive;
  
  use strict; use warnings;
  use parent 'Perl::Tags';
  
  =head1 C<Perl::Tags::Naive>
  
  A naive implementation.  That is to say, it's based on the classic C<pltags.pl>
  script distributed with Perl, which is by and large a better bet than the
  results produced by C<ctags>.  But a "better" approach may be to integrate this
  with PPI.
  
  =head2 Subclassing
  
  See L<TodoTagger> in the C<t/> directory of the distribution for a fully
  working example (tested in <t/02_subclass.t>).  You may want to reuse parsers
  in the ::Naive package, or use all of the existing parsers and add your own.
  
      package My::Tagger;
      use Perl::Tags;
      use parent 'Perl::Tags::Naive';
  
      sub get_parsers {
          my $self = shift;
          return (
              $self->can('todo_line'),     # a new parser
              $self->SUPER::get_parsers(), # all ::Naive's parsers
              # or maybe...
              $self->can('variable'),      # one of ::Naive's parsers
          );
      }
  
      sub todo_line { 
          # your new parser code here!
      }
      sub package_line {
          # override one of ::Naive's parsers
      }
  
  Because ::Naive uses C<can('parser')> instead of C<\&parser>, you
  can just override a particular parser by redefining in the subclass. 
  
  =head2 C<get_tags_for_file>
  
  ::Naive uses a simple line-by-line analysis of Perl code, comparing
  each line against an array of parsers returned by the L<get_parsers> method.
  
  The first of these parsers that matches (if any) will return the
  tag/control to be registred by the tagger.
  
  =cut
  
  {
      # Tags that start POD:
      my @start_tags = qw(pod head1 head2 head3 head4 over item back begin
                          end for encoding);
      my @end_tags = qw(cut);
  
      my $startpod = '^=(?:' . join('|', @start_tags) . ')\b';
      my $endpod = '^=(?:' . join('|', @end_tags) . ')\b';
  
      sub STARTPOD { qr/$startpod/ }
      sub ENDPOD { qr/$endpod/ }
  }
  
  sub get_tags_for_file {
      my ($self, $file) = @_;
  
      my @parsers = $self->get_parsers(); # function refs
  
      open (my $IN, '<', $file) or die "Couldn't open file `$file`: $!\n";
  
      my $start = STARTPOD();
      my $end = ENDPOD();
  
      my @all_tags;
  
      while (<$IN>) {
          next if (/$start/o .. /$end/o);     # Skip over POD.
          chomp;
          my $statement = my $line = $_;
          PARSELOOP: for my $parser (@parsers) {
              my @tags = $parser->( 
                  $self, 
                $line, 
                $statement,
                $file 
              );
              push @all_tags, @tags;
          }
      }
      return @all_tags;
  }
  
  =head2 C<get_parsers>
  
  The following parsers are defined by this module.
  
  =over 4
  
  =cut
  
  sub get_parsers {
      my $self = shift;
      return (
          $self->can('trim'),
          $self->can('variable'),
          $self->can('package_line'),
          $self->can('sub_line'),
          $self->can('use_constant'),
          $self->can('use_line'),
          $self->can('label_line'),
      );
  }
  
  =item C<trim>
  
  A filter rather than a parser, removes whitespace and comments.
  
  =cut
  
  sub trim {
      shift;
      # naughtily work on arg inplace
      $_[1] =~ s/#.*//;  # remove comment.  Naively
      $_[1] =~ s/^\s*//; # Trim spaces
      $_[1] =~ s/\s*$//;
  
      return;
  }
  
  =item C<variable>
  
  Tags definitions of C<my>, C<our>, and C<local> variables.
  
  Returns a L<Perl::Tags::Tag::Var> if found
  
  =cut
  
  sub variable {
      # don't handle continuing thingy for now
      my ($self, $line, $statement, $file) = @_;
  
      return unless $self->{do_variables}; 
          # I'm not sure I see this as all that useful
  
      if ($self->{var_continues} || $statement =~/^(my|our|local)\b/) {
  
          $self->{current}{var_continues} = ! ($statement=~/;$/);
          $statement =~s/=.*$//; 
              # remove RHS with extreme prejudice
              # and also not accounting for things like
              # my $x=my $y=my $z;
  
          my @vars = $statement=~/[\$@%]((?:\w|:)+)\b/g;
  
          # use Data::Dumper;
          # print Dumper({ vars => \@vars, statement => $statement });
  
          return map { 
              Perl::Tags::Tag::Var->new(
                  name => $_,
                  file => $file,
                  line => $line,
                  linenum => $.,
              ); 
          } @vars;
      }
      return;
  }
  
  =item C<package_line>
  
  Parse a package declaration, returning a L<Perl::Tags::Tag::Package> if found.
  
  =cut
  
  sub package_line {
      my ($self, $line, $statement, $file) = @_;
  
      if ($statement=~/^package\s+((?:\w|:)+)\b/) {
          return (
              Perl::Tags::Tag::Package->new(
                  name => $1,
                  file => $file,
                  line => $line,
                  linenum => $.,
              )
          );
      }
      return;
  }
  
  =item C<sub_line>
  
  Parse the declaration of a subroutine, returning a L<Perl::Tags::Tag::Sub> if found.
  
  =cut
  
  sub sub_line {
      my ($self, $line, $statement, $file) = @_;
      if ($statement=~/sub\s+(\w+)\b/) {
          return (
              Perl::Tags::Tag::Sub->new(
                  name => $1,
                  file => $file,
                  line => $line,
                  linenum => $.,
              )
          );
      }
  
      return;
  }
  
  =item C<use_constant>
  
  Parse a use constant directive
  
  =cut
  
  sub use_constant {
      my ($self, $line, $statement, $file) = @_;
      if ($statement =~/^\s*use\s+constant\s+([^=[:space:]]+)/) {
          return (
              Perl::Tags::Tag::Constant->new(
                  name    => $1,
                  file    => $file,
                  line    => $line,
                  linenum => $.,
              )
          );
      }
      return;
  }
  
  =item C<use_line>
  
  Parse a use, require, and also a use_ok line (from Test::More).
  Uses a dummy tag (L<Perl::Tags::Tag::Recurse> to do so).
  
  =cut
  
  sub use_line {
      my ($self, $line, $statement, $file) = @_;
  
      my @ret;
      if ($statement=~/^(?:use|require)(_ok\(?)?\s+(.*)/) {
          my @packages = split /\s+/, $2; # may be more than one if base
          @packages = ($packages[0]) if $1; # if use_ok ecc. from Test::More
  
          for (@packages) {
              s/^q[wq]?[[:punct:]]//;
              /((?:\w|:)+)/;
              $1 and push @ret, Perl::Tags::Tag::Recurse->new( 
                  name => $1, 
                  line=>'dummy' );
          }
      }
      return @ret;
  }
  
  =item C<label_line>
  
  Parse label declaration
  
  =cut
  
  sub label_line {
      my ($self, $line, $statement, $file) = @_;
      if ($statement=~/^\s*([a-zA-Z_][a-zA-Z0-9_]*)\s*:(?:[^:]|$)/) {
          return (
              Perl::Tags::Tag::Label->new(
                  name    => $1,
                  file    => $file,
                  line    => $line,
                  linenum => $.,
              )
          );
      }
      return;
  }
  
  =back
  
  =cut
  
  1;
PERL_TAGS_NAIVE

$fatpacked{"Perl/Tags/Naive/Lib.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERL_TAGS_NAIVE_LIB';
  package Perl::Tags::Naive::Lib;
  
  use strict; use warnings;
  use parent 'Perl::Tags::Naive';
  
  =head2 C<get_parsers>
  
  The following parsers are defined by this module.
  
  =over 4
  
  =cut
  
  sub get_parsers
  {
          my $self = shift;
          return (
                  $self->SUPER::get_parsers(),
                  $self->can('uselib_line'),
          );
  }
  
  
  =item C<uselib_line>
  
  Parse a use/require lib line
  Unshift libraries found onto @INC.
  
  =cut
  
  sub uselib_line {
      my ($self, $line, $statement, $file) = @_;
  
      my @ret;
      if ($statement=~/^(?:use|require)\s+lib\s+(.*)/) {
          my @libraries = split /\s+/, $1; # may be more than one
  
          for (@libraries) {
              s/^q[wq]?[[:punct:]]//;
              /((?:\w|:)+)/;
              $1 and unshift @INC, $1;
          }
      }
      return @ret;
  }
  
  1;
  
  =back
  
  #package Perl::Tags::Tag::Recurse::Lib;
  #
  #our @ISA = qw/Perl::Tags::Tag::Recurse/;
  #
  #=head1 C<Perl::Tags::Tag::Recurse::Lib>
  #
  #=head2 C<type>: dummy
  #
  #=head2 C<on_register>
  #
  #Recurse adding this new module accessible from a use lib statement to the queue.
  #
  #=cut
  #
  #package Perl::Tags::Tag::Recurse;
  #
  #sub on_register {
  #    my ($self, $tags) = @_;
  #
  #    my $name = $self->{name};
  #    my $path;
  #    my @INC_ORIG = @INC;
  #    my @INC = 
  #    eval {
  #        $path = locate( $name ); # or warn "Couldn't find path for $module";
  #    };
  #    # return if $@;
  #    return unless $path;
  #    $tags->queue( { file=>$path, level=>$tags->{current}{level}+1 , refresh=>0} +);
  #    return; # don't get added
  #}
  
  ##
  
  1;
  
  =head1 AUTHOR and LICENSE
  
      dr bean - drbean at sign cpan a dot org
      osfameron (2006) - osfameron@gmail.com
  
  For support, try emailing me or grabbing me on irc #london.pm on irc.perl.org
  
  This was originally ripped off pltags.pl, as distributed with vim
  and available from L<http://www.mscha.com/mscha.html?pltags#tools>
  Version 2.3, 28 February 2002
  Written by Michael Schaap <pltags@mscha.com>.
  
  This is licensed under the same terms as Perl itself.  (Or as Vim if you +prefer).
  
  =cut
PERL_TAGS_NAIVE_LIB

$fatpacked{"Perl/Tags/Naive/Moose.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERL_TAGS_NAIVE_MOOSE';
  use strict; use warnings;
  package Perl::Tags::Naive::Moose;
  
  use parent 'Perl::Tags::Naive';
  
  =head2 C<get_parsers>
  
  The following parsers are defined by this module.
  
  =over 4
  
  =cut
  
  sub get_parsers
  {
  	my $self = shift;
  	return (
  		$self->SUPER::get_parsers(),
  		$self->can('extends_line'),
  		$self->can('with_line'),
  		$self->can('has_line'),
  		$self->can('around_line'),
  		$self->can('before_line'),
  		$self->can('after_line'),
  		$self->can('override_line'),
  		$self->can('augment_line'),
  		$self->can('class_line'),
  		$self->can('method_line'),
  		$self->can('role_line'),
  	);
  }
  
  =item C<extends_line>
  
  Parse the declaration of a 'extends' Moose keyword, returning a L<Perl::Tags::Tag::Extends> if found.
  
  =cut
  
  sub extends_line {
      my ($self, $line, $statement, $file) = @_;
      if ($statement=~/extends\s+["']?((?:\w+|::)+)\b/) {
  	return Perl::Tags::Tag::Recurse->new(
  	    name    => $1,
  	    line    => 'dummy',
  	);
      }
      return;
  }
  
  =item C<with_line>
  
  Parse the declaration of a 'with' Moose keyword, returning a L<Perl::Tags::Tag::With> tag if found.
  
  =cut
  
  sub with_line {
      my ( $self, $line, $statement, $file ) = @_;
      if ( $statement =~ m/\bwith\s+(?:qw.)?\W*([a-zA-Z0-9_: ]+)/ ) {
          my @roles = split /\s+/, $1;
          my @returns;
          foreach my $role (@roles) {
              push @returns, Perl::Tags::Tag::Recurse->new(
  		name    => $role,
  		line    => 'dummy',
              );
          }
          return @returns;
      }
      return;
  }
  
  =item C<has_line>
  
  Parse the declaration of a 'has' Moose keyword, returning a L<Perl::Tags::Tag::Has> if found.
  
  =cut
  
  sub has_line {
      my ($self, $line, $statement, $file) = @_;
      if ($statement=~/\bhas\s+["']?(\w+)\b/) {
          return (
              Perl::Tags::Tag::Has->new(
                  name => $1,
                  file => $file,
                  line => $line,
                  linenum => $.,
              )
          );
      }
      return;
  }
  
  =item C<around_line>
  
  Parse the declaration of a 'around' Moose keyword, returning a L<Perl::Tags::Tag::Around> tag if found.
  
  =cut
  
  sub around_line {
      my ($self, $line, $statement, $file) = @_;
      if ($statement=~/around\s+["'](\w+)\b/) {
          return (
              Perl::Tags::Tag::Around->new(
                  name => $1,
                  file => $file,
                  line => $line,
                  linenum => $.,
              )
          );
      }
      return;
  }
  
  =item C<before_line>
  
  Parse the declaration of a 'before' Moose keyword, returning a L<Perl::Tags::Tag::Before> tag if found.
  
  =cut
  
  sub before_line {
      my ($self, $line, $statement, $file) = @_;
      if ($statement=~/before\s+["'](\w+)\b/) {
          return (
              Perl::Tags::Tag::Before->new(
                  name => $1,
                  file => $file,
                  line => $line,
                  linenum => $.,
              )
          );
      }
      return;
  }
  
  =item C<after_line>
  
  Parse the declaration of a 'after' Moose keyword, returning a L<Perl::Tags::Tag::After> tag if found.
  
  =cut
  
  sub after_line {
      my ($self, $line, $statement, $file) = @_;
      if ($statement=~/after\s+["'](\w+)\b/) {
          return (
              Perl::Tags::Tag::After->new(
                  name => $1,
                  file => $file,
                  line => $line,
                  linenum => $.,
              )
          );
      }
      return;
  }
  
  =item C<override_line>
  
  Parse the declaration of a 'override' Moose keyword, returning a L<Perl::Tags::Tag::Override> tag if found.
  
  =cut
  
  sub override_line {
      my ($self, $line, $statement, $file) = @_;
      if ($statement=~/override\s+["'](\w+)\b/) {
          return (
              Perl::Tags::Tag::Override->new(
                  name => $1,
                  file => $file,
                  line => $line,
                  linenum => $.,
              )
          );
      }
      return;
  }
  
  =item C<augment_line>
  
  Parse the declaration of a 'augment' Moose keyword, returning a L<Perl::Tags::Tag::Augment> tag if found.
  
  =cut
  
  sub augment_line {
      my ($self, $line, $statement, $file) = @_;
      if ($statement=~/augment\s+["']?(\w+)\b/) {
          return (
              Perl::Tags::Tag::Augment->new(
                  name => $1,
                  file => $file,
                  line => $line,
                  linenum => $.,
              )
          );
      }
      return;
  }
  
  =item C<class_line>
  
  Parse the declaration of a 'class' Moose keyword, returning a L<Perl::Tags::Tag::Class> tag if found.
  
  =cut
  
  sub class_line {
      my ($self, $line, $statement, $file) = @_;
      if ($statement=~/class\s+(\w+)\b/) {
          return (
              Perl::Tags::Tag::Class->new(
                  name => $1,
                  file => $file,
                  line => $line,
                  linenum => $.,
              )
          );
      }
      return;
  }
  
  =item C<method_line>
  
  Parse the declaration of a 'method' Moose keyword, returning a L<Perl::Tags::Tag::Method> tag if found.
  
  =cut
  
  sub method_line {
      my ($self, $line, $statement, $file) = @_;
      if ($statement=~/method\s+(\w+)\b/) {
          return (
              Perl::Tags::Tag::Method->new(
                  name => $1,
                  file => $file,
                  line => $line,
                  linenum => $.,
              )
          );
      }
      return;
  }
  
  =item C<role_line>
  
  Parse the declaration of a 'role' Moose keyword, returning a L<Perl::Tags::Tag::Role> tag if found.
  
  =cut
  
  sub role_line {
      my ($self, $line, $statement, $file) = @_;
      if ($statement=~/role\s+(\w+)\b/) {
          return (
              Perl::Tags::Tag::Role->new(
                  name => $1,
                  file => $file,
                  line => $line,
                  linenum => $.,
              )
          );
      }
      return;
  }
  
  =head1 C<Perl::Tags::Tag::Method>
  
  =head2 C<type>: Method
  
  =cut
  
  package Perl::Tags::Tag::Method;
  our @ISA = qw/Perl::Tags::Tag::Sub/;
  
  sub type { 'Method' }
  
  
  =head1 C<Perl::Tags::Tag::Has>
  
  =head2 C<type>: Has
  
  =cut
  
  package Perl::Tags::Tag::Has;
  our @ISA = qw/Perl::Tags::Tag::Method/;
  
  sub type { 'Has' }
  
  =head1 C<Perl::Tags::Tag::Around>
  
  =head2 C<type>: Around
  
  =cut
  
  package Perl::Tags::Tag::Around;
  our @ISA = qw/Perl::Tags::Tag::Method/;
  
  sub type { 'Around' }
  
  =head1 C<Perl::Tags::Tag::Before>
  
  =head2 C<type>: Before
  
  =cut
  
  package Perl::Tags::Tag::Before;
  our @ISA = qw/Perl::Tags::Tag::Method/;
  
  sub type { 'Before' }
  
  =head1 C<Perl::Tags::Tag::After>
  
  =head2 C<type>: After
  
  =cut
  
  package Perl::Tags::Tag::After;
  our @ISA = qw/Perl::Tags::Tag::Method/;
  
  sub type { 'After' }
  
  =head1 C<Perl::Tags::Tag::Override>
  
  =head2 C<type>: Override
  
  =cut
  
  package Perl::Tags::Tag::Override;
  our @ISA = qw/Perl::Tags::Tag::Method/;
  
  sub type { 'Override' }
  
  =head1 C<Perl::Tags::Tag::Augment>
  
  =head2 C<type>: Augment
  
  =cut
  
  package Perl::Tags::Tag::Augment;
  our @ISA = qw/Perl::Tags::Tag::Method/;
  
  sub type { 'Augment' }
  
  =head1 C<Perl::Tags::Tag::Class>
  
  =head2 C<type>: Class
  
  =cut
  
  package Perl::Tags::Tag::Class;
  our @ISA = qw/Perl::Tags::Tag::Package/;
  
  sub type { 'Class' }
  
  =head1 C<Perl::Tags::Tag::Role>
  
  =head2 C<type>: Role
  
  =cut
  
  package Perl::Tags::Tag::Role;
  our @ISA = qw/Perl::Tags::Tag::Package/;
  
  sub type { 'Role' }
  
  1;
  
  =head1 AUTHOR and LICENSE
  
      dr bean - drbean at sign cpan a dot org
  
  This is licensed under the same terms as Perl itself.  (Or as Vim if you +prefer).
  
  =cut
  
  # vim: set ts=8 sts=4 sw=4 noet:
PERL_TAGS_NAIVE_MOOSE

$fatpacked{"Perl/Tags/Naive/Spiffy.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERL_TAGS_NAIVE_SPIFFY';
  package Perl::Tags::Naive::Spiffy;
  
  use strict; use warnings;
  use parent 'Perl::Tags::Naive';
  
  =head2 C<get_parsers>
  
  The following parsers are defined by this module.
  
  =over 4
  
  =cut
  
  sub get_parsers
  {
  	my $self = shift;
  	return (
  		$self->SUPER::get_parsers(),
  		$self->can('field_line'),
  		$self->can('stub_line'),
  	);
  }
  
  =item C<field_line>
  
  Parse the declaration of a Spiffy class accessor method, returning a L<Perl::Tags::Tag::Field> if found.
  
  =cut
  
  sub field_line {
      my ($self, $line, $statement, $file) = @_;
      if ($statement=~/field\s+["']?(\w+)\b/) {
          return (
              Perl::Tags::Tag::Field->new(
                  name => $1,
                  file => $file,
                  line => $line,
                  linenum => $.,
              )
          );
      }
      return;
  }
  
  =item C<stub_line>
  
  Parse the declaration of a Spiffy stub method, returning a L<Perl::Tags::Tag::Stub> if found.
  
  =cut
  
  sub stub_line {
      my ($self, $line, $statement, $file) = @_;
      if ($statement=~/stub\s+["']?(\w+)\b/) {
          return (
              Perl::Tags::Tag::Stub->new(
                  name => $1,
                  file => $file,
                  line => $line,
                  linenum => $.,
              )
          );
      }
      return;
  }
  
  =back
  
  =head1 C<Perl::Tags::Tag::Field>
  
  =head2 C<type>: Field
  
  =cut
  
  package Perl::Tags::Tag::Field;
  our @ISA = qw/Perl::Tags::Tag/;
  
  sub type { 'Field' }
  
  =head1 C<Perl::Tags::Tag::Stub>
  
  =head2 C<type>: Stub
  
  =cut
  
  package Perl::Tags::Tag::Stub;
  our @ISA = qw/Perl::Tags::Tag/;
  
  sub type { 'Stub' }
  
  1;
  
  =head1 AUTHOR and LICENSE
  
      dr bean - drbean at sign cpan a dot org
      osfameron (2006) - osfameron@gmail.com
  
  For support, try emailing me or grabbing me on irc #london.pm on irc.perl.org
  
  This was originally ripped off pltags.pl, as distributed with vim
  and available from L<http://www.mscha.com/mscha.html?pltags#tools>
  Version 2.3, 28 February 2002
  Written by Michael Schaap <pltags@mscha.com>.
  
  This is licensed under the same terms as Perl itself.  (Or as Vim if you +prefer).
  
  =cut
PERL_TAGS_NAIVE_SPIFFY

$fatpacked{"Perl/Tags/PPI.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERL_TAGS_PPI';
  package Perl::Tags::PPI;
  
  use strict; use warnings;
  
  use base qw(Perl::Tags);
  
  use PPI;
  
  sub ppi_all {
      my ( $self, $file ) = @_;
  
      my $doc = PPI::Document->new($file) || return;
  
      $doc->index_locations;
  
      return map { $self->_tagify( $_, "$file" ) }
        @{ $doc->find(sub { $_[1]->isa("PPI::Statement") }) || [] }
  }
  
  sub get_tags_for_file {
      my ( $self, $file, @parsers ) = @_;
  
      my @tags = $self->ppi_all( $file );
  
      return @tags;
  }
  
  sub _tagify {
      my ( $self, $thing, $file ) = @_;
  
      my $class = $thing->class;
  
      my ( $first_line ) = split /\n/, $thing;
  
      if ( my ( $subtype ) = ( $class =~ /^PPI::Statement::(.*)$/ ) ) {
  
          my $method = "_tagify_" . lc($subtype);
  
          if ( $self->can($method) ) {
              return $self->$method( $thing, $file, $first_line );
          }
      }
  
      return $self->_tagify_statement($thing, $file, $first_line);
  }
  
  # catch all
  sub _tagify_statement {
      my ( $self, $thing, $file, $first_line ) = @_;
  
      return;
  }
  
  sub _tagify_sub {
      my ( $self, $thing, $file, $line ) = @_;
  
      return Perl::Tags::Tag::Sub->new(
          name    => $thing->name,
          file    => $file,
          line    => $line,
          linenum => $thing->location->[0],
          pkg     => $thing->guess_package
      );
  }
  
  sub _tagify_variable {
      my ( $self, $thing, $file, $line ) = @_;
      return map {
          Perl::Tags::Tag::Var->new(
              name    => $_,
              file    => $file,
              line    => $line,
              linenum => $thing->location->[0],
            )
      } $thing->variables;
  }
  
  sub _tagify_package {
      my ( $self, $thing, $file, $line ) = @_;
  
      return Perl::Tags::Tag::Package->new(
          name    => $thing->namespace,
          file    => $file,
          line    => $line,
          linenum => $thing->location->[0],
      );
  }
  
  sub _tagify_include {
      my ( $self, $thing, $file ) = @_;
  
      if ( my $module = $thing->module ) {
          return Perl::Tags::Tag::Recurse->new(
              name    => $module,
              line    => "dummy",
          );
      }
  
      return;
  }
  
  sub PPI::Statement::Sub::guess_package {
      my ($self) = @_;
  
      my $temp = $self;
      my $package;
  
      while (1) {
          $temp = $temp->sprevious_sibling
            or last;
  
          if ( $temp->class eq 'PPI::Statement::Package' ) {
              $package = $temp;
              last;
          }
      }
  
      return $package;
  }
  
  =head1 NAME
  
  Perl::Tags::PPI - use PPI to parse 
  
  =head1 DESCRIPTION
  
  This is a drop-in replacement for the basic L<Perl::Tags> parser.  Please see that module's
  perldoc, and test C<t/04_ppi.t> for details.
  
  (Doc patches very welcome!)
  
  =head1 AUTHOR
  
   (c) Wolverian 2006
  
  Modifications by nothingmuch
  
  =cut
  
  1;
PERL_TAGS_PPI

$fatpacked{"Perl/Tags/Tag.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PERL_TAGS_TAG';
  package Perl::Tags::Tag;
  use strict; use warnings;
  
  use overload q("") => \&to_string;
  
  =head2 C<new>
  
  Returns a new tag object
  
  =cut
  
  sub new {
      my $class = shift;
      my %options = @_;
  
      $options{type} = $class->type;
  
      # chomp and escape line
      chomp (my $line = $options{line});
  
      $line =~ s{\\}{\\\\}g;
      $line =~ s{/}{\\/}g;
      # $line =~ s{\$}{\\\$}g;
  
      my $self = bless {
          name   => $options{name},
          file   => $options{file},
          type   => $options{type},
          is_static => $options{is_static},
          line   => $line,
          linenum => $options{linenum},
          exts   => $options{exts}, # exuberant?
          pkg    => $options{pkg},  # package name
      }, $class;
  
      $self->modify_options();
      return $self;
  }
  
  =head2 C<type>, C<modify_options>
  
  Abstract methods
  
  =cut
  
  sub type {
      die "Tried to call 'type' on virtual superclass";
  }
  
  sub modify_options { return } # no change
  
  =head2 C<to_string>
  
  A tag stringifies to an appropriate line in a ctags file.
  
  =cut
  
  sub to_string {
      my $self = shift;
  
      my $name = $self->{name} or die;
      my $file = $self->{file} or die;
      my $line = $self->{line} or die;
      my $linenum = $self->{linenum};
      my $pkg  = $self->{pkg} || '';
  
      my $tagline = "$name\t$file\t/$line/";
  
      # Exuberant extensions
      if ($self->{exts}) {
          $tagline .= qq(;"\t$self->{type});
          $tagline .= "\tline:$linenum";
          $tagline .= ($self->{is_static} ? "\tfile:" : '');
          $tagline .= ($self->{pkg} ? "\tclass:$self->{pkg}" : '');
      }
      return $tagline;
  }
  
  =head2 C<on_register>
  
  Allows tag to meddle with process when registered with the main tagger object.
  Return false if want to prevent registration (e.g. for control tags such as
  C<Perl::Tags::Tag::Recurse>.)
  
  =cut
  
  sub on_register {
      # my $self = shift;
      # my $tags = shift;
      # .... do stuff in subclasses
  
      return 1;  # or undef to prevent registration
  }
  
  =head1 C<Perl::Tags::Tag::Package>
  
  =head2 C<type>: p
  
  =head2 C<modify_options>
  
  Sets static=0
  
  =head2 C<on_register>
  
  Sets the package name
  
  =cut
  
  package Perl::Tags::Tag::Package;
  our @ISA = qw/Perl::Tags::Tag/;
  
      # QUOTE:
          # Make a tag for this package unless we're told not to.  A
          # package is never static.
  
  sub type { 'p' }
  
  sub modify_options {
      my $self = shift;
      $self->{is_static} = 0;
  }
  
  sub on_register {
      my ($self, $tags) = @_;
      $tags->{current}{package_name} = $self->{name};
  }
  
  =head1 C<Perl::Tags::Tag::Var>
  
  =head2 C<type>: v
  
  =head2 C<on_register>
  
          Make a tag for this variable unless we're told not to.  We
          assume that a variable is always static, unless it appears
          in a package before any sub.  (Not necessarily true, but
          it's ok for most purposes and Vim works fine even if it is
          incorrect)
              - pltags.pl comments
  
  =cut
  
  package Perl::Tags::Tag::Var;
  our @ISA = qw/Perl::Tags::Tag/;
  
  sub type { 'v' }
  
      # QUOTE:
  
  sub on_register {
      my ($self, $tags) = @_;
      $self->{is_static} = ( $tags->{current}{package_name} || $tags->{current}{has_subs} ) ? 1 : 0;
  
      return 1;
  }
  =head1 C<Perl::Tags::Tag::Sub>
  
  =head2 C<type>: s
  
  =head2 C<on_register>
  
          Make a tag for this sub unless we're told not to.  We assume
          that a sub is static, unless it appears in a package.  (Not
          necessarily true, but it's ok for most purposes and Vim works
          fine even if it is incorrect)
              - pltags comments
  
  =cut
  
  package Perl::Tags::Tag::Sub;
  our @ISA = qw/Perl::Tags::Tag/;
  
  sub type { 's' }
  
  sub on_register {
      my ($self, $tags) = @_;
      $tags->{current}{has_subs}++ ;
      $self->{is_static}++ unless $tags->{current}{package_name};
  
      return 1;
  } 
  
  =head1 C<Perl::Tags::Tag::Constant>
  
  =head2 C<type>: c
  
  =cut
  
  package Perl::Tags::Tag::Constant;
  our @ISA = qw/Perl::Tags::Tag/;
  
  sub type { 'c' }
  
  =head1 C<Perl::Tags::Tag::Label>
  
  =head2 C<type>: l
  
  =cut
  
  package Perl::Tags::Tag::Label;
  our @ISA = qw/Perl::Tags::Tag/;
  
  sub type { 'l' }
  
  =head1 C<Perl::Tags::Tag::Recurse>
  
  =head2 C<type>: dummy
  
  This is a pseudo-tag, see L<Perl::Tags/register>.
  
  =head2 C<on_register>
  
  Recurse adding this new module to the queue.
  
  =cut
  
  package Perl::Tags::Tag::Recurse;
  our @ISA = qw/Perl::Tags::Tag/;
  
  use Module::Locate qw/locate/;
  
  sub type { 'dummy' }
  
  sub on_register {
      my ($self, $tags) = @_;
  
      my $name = $self->{name};
      my $path;
      eval {
          $path = locate( $name ); # or warn "Couldn't find path for $name";
      };
      # return if $@;
      return unless $path;
      $tags->queue( { file=>$path, level=>$tags->{current}{level}+1 , refresh=>0} );
      return; # don't get added
  }
  
  1;
PERL_TAGS_TAG

$fatpacked{"Test/Perl/Tags.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEST_PERL_TAGS';
  package Test::Perl::Tags;
  
  use strict; use warnings;
  use parent 'Test::Builder::Module';
  
  use Path::Tiny 'path';
  
  our @EXPORT = qw(tag_ok);
  
  =head1 NAME
  
  Test::Perl::Tags - testing output of L<Perl::Tags>
  
  =head1 SYNOPSIS
  
      use Test::Perl::Tags;
  
      # do some tagging
      
      tag_ok $tagger,
          SYMBOL => 'path/to/file.pm' => 'searchable bookmark',
          'Description of this test';
  
      tag_ok $tagger,
          SYMBOL => 'path/to/file.pm' => 'searchable bookmark' => 'p' => 'line:3' => 'class:Test',
          'Add additional parameters for exuberant extension';
  
  =cut
  
  sub tag_ok {
      my ($tagger, $symbol, $path, $bookmark) = splice(@_, 0, 4);
      my $description = pop;
  
      my $canonpath = path($path)->absolute->canonpath;
  
      my $tag = join "\t",
          $symbol,
          $canonpath,
          "/$bookmark/";
  
      # exuberant extensions
      if (@_) {
          $tag .= join "\t",
              q<;">,
              @_; 
      }
  
      my $ok = $tagger =~ /
              ^
              \Q$tag\E
              $
              /mx;
      my $builder = __PACKAGE__->builder;
  
      $builder->ok( $ok, $description )
          or $builder->diag( "Tags did not match:\n$tag" );
  }
  
  1;
TEST_PERL_TAGS

$fatpacked{"x86_64-linux/Clone.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'X86_64-LINUX_CLONE';
  package Clone;
  
  use strict;
  use Carp;
  use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD);
  
  require Exporter;
  require DynaLoader;
  require AutoLoader;
  
  @ISA = qw(Exporter DynaLoader);
  @EXPORT = qw();
  @EXPORT_OK = qw( clone );
  
  $VERSION = '0.36';
  
  bootstrap Clone $VERSION;
  
  1;
  __END__
  
  =head1 NAME
  
  Clone - recursively copy Perl datatypes
  
  =head1 SYNOPSIS
  
    package Foo;
    use parent 'Clone';
  
    package main;
    my $original = Foo->new;
    $copy = $original->clone;
    
    # or
  
    use Clone qw(clone);
    
    $a = { 'foo' => 'bar', 'move' => 'zig' };
    $b = [ 'alpha', 'beta', 'gamma', 'vlissides' ];
    $c = Foo->new;
  
    $d = clone($a);
    $e = clone($b);
    $f = clone($c);
  
  =head1 DESCRIPTION
  
  This module provides a clone() method which makes recursive
  copies of nested hash, array, scalar and reference types, 
  including tied variables and objects.
  
  
  clone() takes a scalar argument and duplicates it. To duplicate lists,
  arrays or hashes, pass them in by reference. e.g.
      
      my $copy = clone (\@array);
  
      # or
  
      my %copy = %{ clone (\%hash) };
  
  =head1 SEE ALSO
  
  L<Storable>'s dclone() is a flexible solution for cloning variables,
  albeit slower for average-sized data structures. Simple
  and naive benchmarks show that Clone is faster for data structures
  with 3 or less levels, while dclone() can be faster for structures
  4 or more levels deep.
  
  =head1 COPYRIGHT
  
  Copyright 2001-2013 Ray Finch. All Rights Reserved.
  
  This module is free software; you can redistribute it and/or
  modify it under the same terms as Perl itself.
  
  =head1 AUTHOR
  
  Ray Finch C<< <rdf@cpan.org> >>
  
  Breno G. de Oliveira C<< <garu@cpan.org> >> and
  Florian Ragwitz C<< <rafl@debian.org> >> perform routine maintenance
  releases since 2012.
  
  =cut
X86_64-LINUX_CLONE

$fatpacked{"x86_64-linux/Cwd.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'X86_64-LINUX_CWD';
  package Cwd;
  
  =head1 NAME
  
  Cwd - get pathname of current working directory
  
  =head1 SYNOPSIS
  
      use Cwd;
      my $dir = getcwd;
  
      use Cwd 'abs_path';
      my $abs_path = abs_path($file);
  
  =head1 DESCRIPTION
  
  This module provides functions for determining the pathname of the
  current working directory.  It is recommended that getcwd (or another
  *cwd() function) be used in I<all> code to ensure portability.
  
  By default, it exports the functions cwd(), getcwd(), fastcwd(), and
  fastgetcwd() (and, on Win32, getdcwd()) into the caller's namespace.  
  
  
  =head2 getcwd and friends
  
  Each of these functions are called without arguments and return the
  absolute path of the current working directory.
  
  =over 4
  
  =item getcwd
  
      my $cwd = getcwd();
  
  Returns the current working directory.
  
  Exposes the POSIX function getcwd(3) or re-implements it if it's not
  available.
  
  =item cwd
  
      my $cwd = cwd();
  
  The cwd() is the most natural form for the current architecture.  For
  most systems it is identical to `pwd` (but without the trailing line
  terminator).
  
  =item fastcwd
  
      my $cwd = fastcwd();
  
  A more dangerous version of getcwd(), but potentially faster.
  
  It might conceivably chdir() you out of a directory that it can't
  chdir() you back into.  If fastcwd encounters a problem it will return
  undef but will probably leave you in a different directory.  For a
  measure of extra security, if everything appears to have worked, the
  fastcwd() function will check that it leaves you in the same directory
  that it started in.  If it has changed it will C<die> with the message
  "Unstable directory path, current directory changed
  unexpectedly".  That should never happen.
  
  =item fastgetcwd
  
    my $cwd = fastgetcwd();
  
  The fastgetcwd() function is provided as a synonym for cwd().
  
  =item getdcwd
  
      my $cwd = getdcwd();
      my $cwd = getdcwd('C:');
  
  The getdcwd() function is also provided on Win32 to get the current working
  directory on the specified drive, since Windows maintains a separate current
  working directory for each drive.  If no drive is specified then the current
  drive is assumed.
  
  This function simply calls the Microsoft C library _getdcwd() function.
  
  =back
  
  
  =head2 abs_path and friends
  
  These functions are exported only on request.  They each take a single
  argument and return the absolute pathname for it.  If no argument is
  given they'll use the current working directory.
  
  =over 4
  
  =item abs_path
  
    my $abs_path = abs_path($file);
  
  Uses the same algorithm as getcwd().  Symbolic links and relative-path
  components ("." and "..") are resolved to return the canonical
  pathname, just like realpath(3).
  
  =item realpath
  
    my $abs_path = realpath($file);
  
  A synonym for abs_path().
  
  =item fast_abs_path
  
    my $abs_path = fast_abs_path($file);
  
  A more dangerous, but potentially faster version of abs_path.
  
  =back
  
  =head2 $ENV{PWD}
  
  If you ask to override your chdir() built-in function, 
  
    use Cwd qw(chdir);
  
  then your PWD environment variable will be kept up to date.  Note that
  it will only be kept up to date if all packages which use chdir import
  it from Cwd.
  
  
  =head1 NOTES
  
  =over 4
  
  =item *
  
  Since the path separators are different on some operating systems ('/'
  on Unix, ':' on MacPerl, etc...) we recommend you use the File::Spec
  modules wherever portability is a concern.
  
  =item *
  
  Actually, on Mac OS, the C<getcwd()>, C<fastgetcwd()> and C<fastcwd()>
  functions are all aliases for the C<cwd()> function, which, on Mac OS,
  calls `pwd`.  Likewise, the C<abs_path()> function is an alias for
  C<fast_abs_path()>.
  
  =back
  
  =head1 AUTHOR
  
  Originally by the perl5-porters.
  
  Maintained by Ken Williams <KWILLIAMS@cpan.org>
  
  =head1 COPYRIGHT
  
  Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
  
  This program is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself.
  
  Portions of the C code in this library are copyright (c) 1994 by the
  Regents of the University of California.  All rights reserved.  The
  license on this code is compatible with the licensing of the rest of
  the distribution - please see the source code in F<Cwd.xs> for the
  details.
  
  =head1 SEE ALSO
  
  L<File::chdir>
  
  =cut
  
  use strict;
  use Exporter;
  use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
  
  $VERSION = '3.40';
  my $xs_version = $VERSION;
  $VERSION =~ tr/_//;
  
  @ISA = qw/ Exporter /;
  @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
  push @EXPORT, qw(getdcwd) if $^O eq 'MSWin32';
  @EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
  
  # sys_cwd may keep the builtin command
  
  # All the functionality of this module may provided by builtins,
  # there is no sense to process the rest of the file.
  # The best choice may be to have this in BEGIN, but how to return from BEGIN?
  
  if ($^O eq 'os2') {
      local $^W = 0;
  
      *cwd                = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
      *getcwd             = \&cwd;
      *fastgetcwd         = \&cwd;
      *fastcwd            = \&cwd;
  
      *fast_abs_path      = \&sys_abspath if defined &sys_abspath;
      *abs_path           = \&fast_abs_path;
      *realpath           = \&fast_abs_path;
      *fast_realpath      = \&fast_abs_path;
  
      return 1;
  }
  
  # Need to look up the feature settings on VMS.  The preferred way is to use the
  # VMS::Feature module, but that may not be available to dual life modules.
  
  my $use_vms_feature;
  BEGIN {
      if ($^O eq 'VMS') {
          if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
              $use_vms_feature = 1;
          }
      }
  }
  
  # Need to look up the UNIX report mode.  This may become a dynamic mode
  # in the future.
  sub _vms_unix_rpt {
      my $unix_rpt;
      if ($use_vms_feature) {
          $unix_rpt = VMS::Feature::current("filename_unix_report");
      } else {
          my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
          $unix_rpt = $env_unix_rpt =~ /^[ET1]/i; 
      }
      return $unix_rpt;
  }
  
  # Need to look up the EFS character set mode.  This may become a dynamic
  # mode in the future.
  sub _vms_efs {
      my $efs;
      if ($use_vms_feature) {
          $efs = VMS::Feature::current("efs_charset");
      } else {
          my $env_efs = $ENV{'DECC$EFS_CHARSET'} || '';
          $efs = $env_efs =~ /^[ET1]/i; 
      }
      return $efs;
  }
  
  
  # If loading the XS stuff doesn't work, we can fall back to pure perl
  eval {
    if ( $] >= 5.006 ) {
      require XSLoader;
      XSLoader::load( __PACKAGE__, $xs_version);
    } else {
      require DynaLoader;
      push @ISA, 'DynaLoader';
      __PACKAGE__->bootstrap( $xs_version );
    }
  };
  
  # Big nasty table of function aliases
  my %METHOD_MAP =
    (
     VMS =>
     {
      cwd			=> '_vms_cwd',
      getcwd		=> '_vms_cwd',
      fastcwd		=> '_vms_cwd',
      fastgetcwd		=> '_vms_cwd',
      abs_path		=> '_vms_abs_path',
      fast_abs_path	=> '_vms_abs_path',
     },
  
     MSWin32 =>
     {
      # We assume that &_NT_cwd is defined as an XSUB or in the core.
      cwd			=> '_NT_cwd',
      getcwd		=> '_NT_cwd',
      fastcwd		=> '_NT_cwd',
      fastgetcwd		=> '_NT_cwd',
      abs_path		=> 'fast_abs_path',
      realpath		=> 'fast_abs_path',
     },
  
     dos => 
     {
      cwd			=> '_dos_cwd',
      getcwd		=> '_dos_cwd',
      fastgetcwd		=> '_dos_cwd',
      fastcwd		=> '_dos_cwd',
      abs_path		=> 'fast_abs_path',
     },
  
     # QNX4.  QNX6 has a $os of 'nto'.
     qnx =>
     {
      cwd			=> '_qnx_cwd',
      getcwd		=> '_qnx_cwd',
      fastgetcwd		=> '_qnx_cwd',
      fastcwd		=> '_qnx_cwd',
      abs_path		=> '_qnx_abs_path',
      fast_abs_path	=> '_qnx_abs_path',
     },
  
     cygwin =>
     {
      getcwd		=> 'cwd',
      fastgetcwd		=> 'cwd',
      fastcwd		=> 'cwd',
      abs_path		=> 'fast_abs_path',
      realpath		=> 'fast_abs_path',
     },
  
     epoc =>
     {
      cwd			=> '_epoc_cwd',
      getcwd	        => '_epoc_cwd',
      fastgetcwd		=> '_epoc_cwd',
      fastcwd		=> '_epoc_cwd',
      abs_path		=> 'fast_abs_path',
     },
  
     MacOS =>
     {
      getcwd		=> 'cwd',
      fastgetcwd		=> 'cwd',
      fastcwd		=> 'cwd',
      abs_path		=> 'fast_abs_path',
     },
    );
  
  $METHOD_MAP{NT} = $METHOD_MAP{MSWin32};
  
  
  # Find the pwd command in the expected locations.  We assume these
  # are safe.  This prevents _backtick_pwd() consulting $ENV{PATH}
  # so everything works under taint mode.
  my $pwd_cmd;
  foreach my $try ('/bin/pwd',
  		 '/usr/bin/pwd',
  		 '/QOpenSys/bin/pwd', # OS/400 PASE.
  		) {
  
      if( -x $try ) {
          $pwd_cmd = $try;
          last;
      }
  }
  my $found_pwd_cmd = defined($pwd_cmd);
  unless ($pwd_cmd) {
      # Isn't this wrong?  _backtick_pwd() will fail if somenone has
      # pwd in their path but it is not /bin/pwd or /usr/bin/pwd?
      # See [perl #16774]. --jhi
      $pwd_cmd = 'pwd';
  }
  
  # Lazy-load Carp
  sub _carp  { require Carp; Carp::carp(@_)  }
  sub _croak { require Carp; Carp::croak(@_) }
  
  # The 'natural and safe form' for UNIX (pwd may be setuid root)
  sub _backtick_pwd {
      # Localize %ENV entries in a way that won't create new hash keys
      my @localize = grep exists $ENV{$_}, qw(PATH IFS CDPATH ENV BASH_ENV);
      local @ENV{@localize};
      
      my $cwd = `$pwd_cmd`;
      # Belt-and-suspenders in case someone said "undef $/".
      local $/ = "\n";
      # `pwd` may fail e.g. if the disk is full
      chomp($cwd) if defined $cwd;
      $cwd;
  }
  
  # Since some ports may predefine cwd internally (e.g., NT)
  # we take care not to override an existing definition for cwd().
  
  unless ($METHOD_MAP{$^O}{cwd} or defined &cwd) {
      # The pwd command is not available in some chroot(2)'ed environments
      my $sep = $Config::Config{path_sep} || ':';
      my $os = $^O;  # Protect $^O from tainting
  
  
      # Try again to find a pwd, this time searching the whole PATH.
      if (defined $ENV{PATH} and $os ne 'MSWin32') {  # no pwd on Windows
  	my @candidates = split($sep, $ENV{PATH});
  	while (!$found_pwd_cmd and @candidates) {
  	    my $candidate = shift @candidates;
  	    $found_pwd_cmd = 1 if -x "$candidate/pwd";
  	}
      }
  
      # MacOS has some special magic to make `pwd` work.
      if( $os eq 'MacOS' || $found_pwd_cmd )
      {
  	*cwd = \&_backtick_pwd;
      }
      else {
  	*cwd = \&getcwd;
      }
  }
  
  if ($^O eq 'cygwin') {
    # We need to make sure cwd() is called with no args, because it's
    # got an arg-less prototype and will die if args are present.
    local $^W = 0;
    my $orig_cwd = \&cwd;
    *cwd = sub { &$orig_cwd() }
  }
  
  
  # set a reasonable (and very safe) default for fastgetcwd, in case it
  # isn't redefined later (20001212 rspier)
  *fastgetcwd = \&cwd;
  
  # A non-XS version of getcwd() - also used to bootstrap the perl build
  # process, when miniperl is running and no XS loading happens.
  sub _perl_getcwd
  {
      abs_path('.');
  }
  
  # By John Bazik
  #
  # Usage: $cwd = &fastcwd;
  #
  # This is a faster version of getcwd.  It's also more dangerous because
  # you might chdir out of a directory that you can't chdir back into.
      
  sub fastcwd_ {
      my($odev, $oino, $cdev, $cino, $tdev, $tino);
      my(@path, $path);
      local(*DIR);
  
      my($orig_cdev, $orig_cino) = stat('.');
      ($cdev, $cino) = ($orig_cdev, $orig_cino);
      for (;;) {
  	my $direntry;
  	($odev, $oino) = ($cdev, $cino);
  	CORE::chdir('..') || return undef;
  	($cdev, $cino) = stat('.');
  	last if $odev == $cdev && $oino == $cino;
  	opendir(DIR, '.') || return undef;
  	for (;;) {
  	    $direntry = readdir(DIR);
  	    last unless defined $direntry;
  	    next if $direntry eq '.';
  	    next if $direntry eq '..';
  
  	    ($tdev, $tino) = lstat($direntry);
  	    last unless $tdev != $odev || $tino != $oino;
  	}
  	closedir(DIR);
  	return undef unless defined $direntry; # should never happen
  	unshift(@path, $direntry);
      }
      $path = '/' . join('/', @path);
      if ($^O eq 'apollo') { $path = "/".$path; }
      # At this point $path may be tainted (if tainting) and chdir would fail.
      # Untaint it then check that we landed where we started.
      $path =~ /^(.*)\z/s		# untaint
  	&& CORE::chdir($1) or return undef;
      ($cdev, $cino) = stat('.');
      die "Unstable directory path, current directory changed unexpectedly"
  	if $cdev != $orig_cdev || $cino != $orig_cino;
      $path;
  }
  if (not defined &fastcwd) { *fastcwd = \&fastcwd_ }
  
  
  # Keeps track of current working directory in PWD environment var
  # Usage:
  #	use Cwd 'chdir';
  #	chdir $newdir;
  
  my $chdir_init = 0;
  
  sub chdir_init {
      if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos' and $^O ne 'MSWin32') {
  	my($dd,$di) = stat('.');
  	my($pd,$pi) = stat($ENV{'PWD'});
  	if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
  	    $ENV{'PWD'} = cwd();
  	}
      }
      else {
  	my $wd = cwd();
  	$wd = Win32::GetFullPathName($wd) if $^O eq 'MSWin32';
  	$ENV{'PWD'} = $wd;
      }
      # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
      if ($^O ne 'MSWin32' and $ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|s) {
  	my($pd,$pi) = stat($2);
  	my($dd,$di) = stat($1);
  	if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
  	    $ENV{'PWD'}="$2$3";
  	}
      }
      $chdir_init = 1;
  }
  
  sub chdir {
      my $newdir = @_ ? shift : '';	# allow for no arg (chdir to HOME dir)
      $newdir =~ s|///*|/|g unless $^O eq 'MSWin32';
      chdir_init() unless $chdir_init;
      my $newpwd;
      if ($^O eq 'MSWin32') {
  	# get the full path name *before* the chdir()
  	$newpwd = Win32::GetFullPathName($newdir);
      }
  
      return 0 unless CORE::chdir $newdir;
  
      if ($^O eq 'VMS') {
  	return $ENV{'PWD'} = $ENV{'DEFAULT'}
      }
      elsif ($^O eq 'MacOS') {
  	return $ENV{'PWD'} = cwd();
      }
      elsif ($^O eq 'MSWin32') {
  	$ENV{'PWD'} = $newpwd;
  	return 1;
      }
  
      if (ref $newdir eq 'GLOB') { # in case a file/dir handle is passed in
  	$ENV{'PWD'} = cwd();
      } elsif ($newdir =~ m#^/#s) {
  	$ENV{'PWD'} = $newdir;
      } else {
  	my @curdir = split(m#/#,$ENV{'PWD'});
  	@curdir = ('') unless @curdir;
  	my $component;
  	foreach $component (split(m#/#, $newdir)) {
  	    next if $component eq '.';
  	    pop(@curdir),next if $component eq '..';
  	    push(@curdir,$component);
  	}
  	$ENV{'PWD'} = join('/',@curdir) || '/';
      }
      1;
  }
  
  
  sub _perl_abs_path
  {
      my $start = @_ ? shift : '.';
      my($dotdots, $cwd, @pst, @cst, $dir, @tst);
  
      unless (@cst = stat( $start ))
      {
  	_carp("stat($start): $!");
  	return '';
      }
  
      unless (-d _) {
          # Make sure we can be invoked on plain files, not just directories.
          # NOTE that this routine assumes that '/' is the only directory separator.
  	
          my ($dir, $file) = $start =~ m{^(.*)/(.+)$}
  	    or return cwd() . '/' . $start;
  	
  	# Can't use "-l _" here, because the previous stat was a stat(), not an lstat().
  	if (-l $start) {
  	    my $link_target = readlink($start);
  	    die "Can't resolve link $start: $!" unless defined $link_target;
  	    
  	    require File::Spec;
              $link_target = $dir . '/' . $link_target
                  unless File::Spec->file_name_is_absolute($link_target);
  	    
  	    return abs_path($link_target);
  	}
  	
  	return $dir ? abs_path($dir) . "/$file" : "/$file";
      }
  
      $cwd = '';
      $dotdots = $start;
      do
      {
  	$dotdots .= '/..';
  	@pst = @cst;
  	local *PARENT;
  	unless (opendir(PARENT, $dotdots))
  	{
  	    # probably a permissions issue.  Try the native command.
  	    require File::Spec;
  	    return File::Spec->rel2abs( $start, _backtick_pwd() );
  	}
  	unless (@cst = stat($dotdots))
  	{
  	    _carp("stat($dotdots): $!");
  	    closedir(PARENT);
  	    return '';
  	}
  	if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
  	{
  	    $dir = undef;
  	}
  	else
  	{
  	    do
  	    {
  		unless (defined ($dir = readdir(PARENT)))
  	        {
  		    _carp("readdir($dotdots): $!");
  		    closedir(PARENT);
  		    return '';
  		}
  		$tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir"))
  	    }
  	    while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
  		   $tst[1] != $pst[1]);
  	}
  	$cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ;
  	closedir(PARENT);
      } while (defined $dir);
      chop($cwd) unless $cwd eq '/'; # drop the trailing /
      $cwd;
  }
  
  
  my $Curdir;
  sub fast_abs_path {
      local $ENV{PWD} = $ENV{PWD} || ''; # Guard against clobberage
      my $cwd = getcwd();
      require File::Spec;
      my $path = @_ ? shift : ($Curdir ||= File::Spec->curdir);
  
      # Detaint else we'll explode in taint mode.  This is safe because
      # we're not doing anything dangerous with it.
      ($path) = $path =~ /(.*)/s;
      ($cwd)  = $cwd  =~ /(.*)/s;
  
      unless (-e $path) {
   	_croak("$path: No such file or directory");
      }
  
      unless (-d _) {
          # Make sure we can be invoked on plain files, not just directories.
  	
  	my ($vol, $dir, $file) = File::Spec->splitpath($path);
  	return File::Spec->catfile($cwd, $path) unless length $dir;
  
  	if (-l $path) {
  	    my $link_target = readlink($path);
  	    die "Can't resolve link $path: $!" unless defined $link_target;
  	    
  	    $link_target = File::Spec->catpath($vol, $dir, $link_target)
                  unless File::Spec->file_name_is_absolute($link_target);
  	    
  	    return fast_abs_path($link_target);
  	}
  	
  	return $dir eq File::Spec->rootdir
  	  ? File::Spec->catpath($vol, $dir, $file)
  	  : fast_abs_path(File::Spec->catpath($vol, $dir, '')) . '/' . $file;
      }
  
      if (!CORE::chdir($path)) {
   	_croak("Cannot chdir to $path: $!");
      }
      my $realpath = getcwd();
      if (! ((-d $cwd) && (CORE::chdir($cwd)))) {
   	_croak("Cannot chdir back to $cwd: $!");
      }
      $realpath;
  }
  
  # added function alias to follow principle of least surprise
  # based on previous aliasing.  --tchrist 27-Jan-00
  *fast_realpath = \&fast_abs_path;
  
  
  # --- PORTING SECTION ---
  
  # VMS: $ENV{'DEFAULT'} points to default directory at all times
  # 06-Mar-1996  Charles Bailey  bailey@newman.upenn.edu
  # Note: Use of Cwd::chdir() causes the logical name PWD to be defined
  #   in the process logical name table as the default device and directory
  #   seen by Perl. This may not be the same as the default device
  #   and directory seen by DCL after Perl exits, since the effects
  #   the CRTL chdir() function persist only until Perl exits.
  
  sub _vms_cwd {
      return $ENV{'DEFAULT'};
  }
  
  sub _vms_abs_path {
      return $ENV{'DEFAULT'} unless @_;
      my $path = shift;
  
      my $efs = _vms_efs;
      my $unix_rpt = _vms_unix_rpt;
  
      if (defined &VMS::Filespec::vmsrealpath) {
          my $path_unix = 0;
          my $path_vms = 0;
  
          $path_unix = 1 if ($path =~ m#(?<=\^)/#);
          $path_unix = 1 if ($path =~ /^\.\.?$/);
          $path_vms = 1 if ($path =~ m#[\[<\]]#);
          $path_vms = 1 if ($path =~ /^--?$/);
  
          my $unix_mode = $path_unix;
          if ($efs) {
              # In case of a tie, the Unix report mode decides.
              if ($path_vms == $path_unix) {
                  $unix_mode = $unix_rpt;
              } else {
                  $unix_mode = 0 if $path_vms;
              }
          }
  
          if ($unix_mode) {
              # Unix format
              return VMS::Filespec::unixrealpath($path);
          }
  
  	# VMS format
  
  	my $new_path = VMS::Filespec::vmsrealpath($path);
  
  	# Perl expects directories to be in directory format
  	$new_path = VMS::Filespec::pathify($new_path) if -d $path;
  	return $new_path;
      }
  
      # Fallback to older algorithm if correct ones are not
      # available.
  
      if (-l $path) {
          my $link_target = readlink($path);
          die "Can't resolve link $path: $!" unless defined $link_target;
  
          return _vms_abs_path($link_target);
      }
  
      # may need to turn foo.dir into [.foo]
      my $pathified = VMS::Filespec::pathify($path);
      $path = $pathified if defined $pathified;
  	
      return VMS::Filespec::rmsexpand($path);
  }
  
  sub _os2_cwd {
      $ENV{'PWD'} = `cmd /c cd`;
      chomp $ENV{'PWD'};
      $ENV{'PWD'} =~ s:\\:/:g ;
      return $ENV{'PWD'};
  }
  
  sub _win32_cwd_simple {
      $ENV{'PWD'} = `cd`;
      chomp $ENV{'PWD'};
      $ENV{'PWD'} =~ s:\\:/:g ;
      return $ENV{'PWD'};
  }
  
  sub _win32_cwd {
      # Need to avoid taking any sort of reference to the typeglob or the code in
      # the optree, so that this tests the runtime state of things, as the
      # ExtUtils::MakeMaker tests for "miniperl" need to be able to fake things at
      # runtime by deleting the subroutine. *foo{THING} syntax on a symbol table
      # lookup avoids needing a string eval, which has been reported to cause
      # problems (for reasons that we haven't been able to get to the bottom of -
      # rt.cpan.org #56225)
      if (*{$DynaLoader::{boot_DynaLoader}}{CODE}) {
  	$ENV{'PWD'} = Win32::GetCwd();
      }
      else { # miniperl
  	chomp($ENV{'PWD'} = `cd`);
      }
      $ENV{'PWD'} =~ s:\\:/:g ;
      return $ENV{'PWD'};
  }
  
  *_NT_cwd = defined &Win32::GetCwd ? \&_win32_cwd : \&_win32_cwd_simple;
  
  sub _dos_cwd {
      if (!defined &Dos::GetCwd) {
          $ENV{'PWD'} = `command /c cd`;
          chomp $ENV{'PWD'};
          $ENV{'PWD'} =~ s:\\:/:g ;
      } else {
          $ENV{'PWD'} = Dos::GetCwd();
      }
      return $ENV{'PWD'};
  }
  
  sub _qnx_cwd {
  	local $ENV{PATH} = '';
  	local $ENV{CDPATH} = '';
  	local $ENV{ENV} = '';
      $ENV{'PWD'} = `/usr/bin/fullpath -t`;
      chomp $ENV{'PWD'};
      return $ENV{'PWD'};
  }
  
  sub _qnx_abs_path {
  	local $ENV{PATH} = '';
  	local $ENV{CDPATH} = '';
  	local $ENV{ENV} = '';
      my $path = @_ ? shift : '.';
      local *REALPATH;
  
      defined( open(REALPATH, '-|') || exec '/usr/bin/fullpath', '-t', $path ) or
        die "Can't open /usr/bin/fullpath: $!";
      my $realpath = <REALPATH>;
      close REALPATH;
      chomp $realpath;
      return $realpath;
  }
  
  sub _epoc_cwd {
      $ENV{'PWD'} = EPOC::getcwd();
      return $ENV{'PWD'};
  }
  
  
  # Now that all the base-level functions are set up, alias the
  # user-level functions to the right places
  
  if (exists $METHOD_MAP{$^O}) {
    my $map = $METHOD_MAP{$^O};
    foreach my $name (keys %$map) {
      local $^W = 0;  # assignments trigger 'subroutine redefined' warning
      no strict 'refs';
      *{$name} = \&{$map->{$name}};
    }
  }
  
  # In case the XS version doesn't load.
  *abs_path = \&_perl_abs_path unless defined &abs_path;
  *getcwd = \&_perl_getcwd unless defined &getcwd;
  
  # added function alias for those of us more
  # used to the libc function.  --tchrist 27-Jan-00
  *realpath = \&abs_path;
  
  1;
X86_64-LINUX_CWD

$fatpacked{"x86_64-linux/File/Spec.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'X86_64-LINUX_FILE_SPEC';
  package File::Spec;
  
  use strict;
  use vars qw(@ISA $VERSION);
  
  $VERSION = '3.40';
  $VERSION =~ tr/_//;
  
  my %module = (MacOS   => 'Mac',
  	      MSWin32 => 'Win32',
  	      os2     => 'OS2',
  	      VMS     => 'VMS',
  	      epoc    => 'Epoc',
  	      NetWare => 'Win32', # Yes, File::Spec::Win32 works on NetWare.
  	      symbian => 'Win32', # Yes, File::Spec::Win32 works on symbian.
  	      dos     => 'OS2',   # Yes, File::Spec::OS2 works on DJGPP.
  	      cygwin  => 'Cygwin');
  
  
  my $module = $module{$^O} || 'Unix';
  
  require "File/Spec/$module.pm";
  @ISA = ("File::Spec::$module");
  
  1;
  
  __END__
  
  =head1 NAME
  
  File::Spec - portably perform operations on file names
  
  =head1 SYNOPSIS
  
  	use File::Spec;
  
  	$x=File::Spec->catfile('a', 'b', 'c');
  
  which returns 'a/b/c' under Unix. Or:
  
  	use File::Spec::Functions;
  
  	$x = catfile('a', 'b', 'c');
  
  =head1 DESCRIPTION
  
  This module is designed to support operations commonly performed on file
  specifications (usually called "file names", but not to be confused with the
  contents of a file, or Perl's file handles), such as concatenating several
  directory and file names into a single path, or determining whether a path
  is rooted. It is based on code directly taken from MakeMaker 5.17, code
  written by Andreas KE<ouml>nig, Andy Dougherty, Charles Bailey, Ilya
  Zakharevich, Paul Schinder, and others.
  
  Since these functions are different for most operating systems, each set of
  OS specific routines is available in a separate module, including:
  
  	File::Spec::Unix
  	File::Spec::Mac
  	File::Spec::OS2
  	File::Spec::Win32
  	File::Spec::VMS
  
  The module appropriate for the current OS is automatically loaded by
  File::Spec. Since some modules (like VMS) make use of facilities available
  only under that OS, it may not be possible to load all modules under all
  operating systems.
  
  Since File::Spec is object oriented, subroutines should not be called directly,
  as in:
  
  	File::Spec::catfile('a','b');
  
  but rather as class methods:
  
  	File::Spec->catfile('a','b');
  
  For simple uses, L<File::Spec::Functions> provides convenient functional
  forms of these methods.
  
  =head1 METHODS
  
  =over 2
  
  =item canonpath
  X<canonpath>
  
  No physical check on the filesystem, but a logical cleanup of a
  path.
  
      $cpath = File::Spec->canonpath( $path ) ;
  
  Note that this does *not* collapse F<x/../y> sections into F<y>.  This
  is by design.  If F</foo> on your system is a symlink to F</bar/baz>,
  then F</foo/../quux> is actually F</bar/quux>, not F</quux> as a naive
  F<../>-removal would give you.  If you want to do this kind of
  processing, you probably want C<Cwd>'s C<realpath()> function to
  actually traverse the filesystem cleaning up paths like this.
  
  =item catdir
  X<catdir>
  
  Concatenate two or more directory names to form a complete path ending
  with a directory. But remove the trailing slash from the resulting
  string, because it doesn't look good, isn't necessary and confuses
  OS/2. Of course, if this is the root directory, don't cut off the
  trailing slash :-)
  
      $path = File::Spec->catdir( @directories );
  
  =item catfile
  X<catfile>
  
  Concatenate one or more directory names and a filename to form a
  complete path ending with a filename
  
      $path = File::Spec->catfile( @directories, $filename );
  
  =item curdir
  X<curdir>
  
  Returns a string representation of the current directory.
  
      $curdir = File::Spec->curdir();
  
  =item devnull
  X<devnull>
  
  Returns a string representation of the null device.
  
      $devnull = File::Spec->devnull();
  
  =item rootdir
  X<rootdir>
  
  Returns a string representation of the root directory.
  
      $rootdir = File::Spec->rootdir();
  
  =item tmpdir
  X<tmpdir>
  
  Returns a string representation of the first writable directory from a
  list of possible temporary directories.  Returns the current directory
  if no writable temporary directories are found.  The list of directories
  checked depends on the platform; e.g. File::Spec::Unix checks C<$ENV{TMPDIR}>
  (unless taint is on) and F</tmp>.
  
      $tmpdir = File::Spec->tmpdir();
  
  =item updir
  X<updir>
  
  Returns a string representation of the parent directory.
  
      $updir = File::Spec->updir();
  
  =item no_upwards
  
  Given a list of file names, strip out those that refer to a parent
  directory. (Does not strip symlinks, only '.', '..', and equivalents.)
  
      @paths = File::Spec->no_upwards( @paths );
  
  =item case_tolerant
  
  Returns a true or false value indicating, respectively, that alphabetic
  case is not or is significant when comparing file specifications.
  Cygwin and Win32 accept an optional drive argument.
  
      $is_case_tolerant = File::Spec->case_tolerant();
  
  =item file_name_is_absolute
  
  Takes as its argument a path, and returns true if it is an absolute path.
  
      $is_absolute = File::Spec->file_name_is_absolute( $path );
  
  This does not consult the local filesystem on Unix, Win32, OS/2, or
  Mac OS (Classic).  It does consult the working environment for VMS
  (see L<File::Spec::VMS/file_name_is_absolute>).
  
  =item path
  X<path>
  
  Takes no argument.  Returns the environment variable C<PATH> (or the local
  platform's equivalent) as a list.
  
      @PATH = File::Spec->path();
  
  =item join
  X<join, path>
  
  join is the same as catfile.
  
  =item splitpath
  X<splitpath> X<split, path>
  
  Splits a path in to volume, directory, and filename portions. On systems
  with no concept of volume, returns '' for volume. 
  
      ($volume,$directories,$file) =
                         File::Spec->splitpath( $path );
      ($volume,$directories,$file) =
                         File::Spec->splitpath( $path, $no_file );
  
  For systems with no syntax differentiating filenames from directories, 
  assumes that the last file is a path unless C<$no_file> is true or a
  trailing separator or F</.> or F</..> is present. On Unix, this means that C<$no_file>
  true makes this return ( '', $path, '' ).
  
  The directory portion may or may not be returned with a trailing '/'.
  
  The results can be passed to L</catpath()> to get back a path equivalent to
  (usually identical to) the original path.
  
  =item splitdir
  X<splitdir> X<split, dir>
  
  The opposite of L</catdir>.
  
      @dirs = File::Spec->splitdir( $directories );
  
  C<$directories> must be only the directory portion of the path on systems 
  that have the concept of a volume or that have path syntax that differentiates
  files from directories.
  
  Unlike just splitting the directories on the separator, empty
  directory names (C<''>) can be returned, because these are significant
  on some OSes.
  
  =item catpath()
  
  Takes volume, directory and file portions and returns an entire path. Under
  Unix, C<$volume> is ignored, and directory and file are concatenated.  A '/' is
  inserted if need be.  On other OSes, C<$volume> is significant.
  
      $full_path = File::Spec->catpath( $volume, $directory, $file );
  
  =item abs2rel
  X<abs2rel> X<absolute, path> X<relative, path>
  
  Takes a destination path and an optional base path returns a relative path
  from the base path to the destination path:
  
      $rel_path = File::Spec->abs2rel( $path ) ;
      $rel_path = File::Spec->abs2rel( $path, $base ) ;
  
  If C<$base> is not present or '', then L<Cwd::cwd()|Cwd> is used. If C<$base> is
  relative, then it is converted to absolute form using
  L</rel2abs()>. This means that it is taken to be relative to
  L<Cwd::cwd()|Cwd>.
  
  On systems with the concept of volume, if C<$path> and C<$base> appear to be
  on two different volumes, we will not attempt to resolve the two
  paths, and we will instead simply return C<$path>.  Note that previous
  versions of this module ignored the volume of C<$base>, which resulted in
  garbage results part of the time.
  
  On systems that have a grammar that indicates filenames, this ignores the 
  C<$base> filename as well. Otherwise all path components are assumed to be
  directories.
  
  If C<$path> is relative, it is converted to absolute form using L</rel2abs()>.
  This means that it is taken to be relative to L<Cwd::cwd()|Cwd>.
  
  No checks against the filesystem are made.  On VMS, there is
  interaction with the working environment, as logicals and
  macros are expanded.
  
  Based on code written by Shigio Yamaguchi.
  
  =item rel2abs()
  X<rel2abs> X<absolute, path> X<relative, path>
  
  Converts a relative path to an absolute path. 
  
      $abs_path = File::Spec->rel2abs( $path ) ;
      $abs_path = File::Spec->rel2abs( $path, $base ) ;
  
  If C<$base> is not present or '', then L<Cwd::cwd()|Cwd> is used. If C<$base> is relative,
  then it is converted to absolute form using L</rel2abs()>. This means that it
  is taken to be relative to L<Cwd::cwd()|Cwd>.
  
  On systems with the concept of volume, if C<$path> and C<$base> appear to be
  on two different volumes, we will not attempt to resolve the two
  paths, and we will instead simply return C<$path>.  Note that previous
  versions of this module ignored the volume of C<$base>, which resulted in
  garbage results part of the time.
  
  On systems that have a grammar that indicates filenames, this ignores the 
  C<$base> filename as well. Otherwise all path components are assumed to be
  directories.
  
  If C<$path> is absolute, it is cleaned up and returned using L</canonpath>.
  
  No checks against the filesystem are made.  On VMS, there is
  interaction with the working environment, as logicals and
  macros are expanded.
  
  Based on code written by Shigio Yamaguchi.
  
  =back
  
  For further information, please see L<File::Spec::Unix>,
  L<File::Spec::Mac>, L<File::Spec::OS2>, L<File::Spec::Win32>, or
  L<File::Spec::VMS>.
  
  =head1 SEE ALSO
  
  L<File::Spec::Unix>, L<File::Spec::Mac>, L<File::Spec::OS2>,
  L<File::Spec::Win32>, L<File::Spec::VMS>, L<File::Spec::Functions>,
  L<ExtUtils::MakeMaker>
  
  =head1 AUTHOR
  
  Currently maintained by Ken Williams C<< <KWILLIAMS@cpan.org> >>.
  
  The vast majority of the code was written by
  Kenneth Albanowski C<< <kjahds@kjahds.com> >>,
  Andy Dougherty C<< <doughera@lafayette.edu> >>,
  Andreas KE<ouml>nig C<< <A.Koenig@franz.ww.TU-Berlin.DE> >>,
  Tim Bunce C<< <Tim.Bunce@ig.co.uk> >>.
  VMS support by Charles Bailey C<< <bailey@newman.upenn.edu> >>.
  OS/2 support by Ilya Zakharevich C<< <ilya@math.ohio-state.edu> >>.
  Mac support by Paul Schinder C<< <schinder@pobox.com> >>, and
  Thomas Wegner C<< <wegner_thomas@yahoo.com> >>.
  abs2rel() and rel2abs() written by Shigio Yamaguchi C<< <shigio@tamacom.com> >>,
  modified by Barrie Slaymaker C<< <barries@slaysys.com> >>.
  splitpath(), splitdir(), catpath() and catdir() by Barrie Slaymaker.
  
  =head1 COPYRIGHT
  
  Copyright (c) 2004-2013 by the Perl 5 Porters.  All rights reserved.
  
  This program is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself.
  
  =cut
X86_64-LINUX_FILE_SPEC

$fatpacked{"x86_64-linux/File/Spec/Cygwin.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'X86_64-LINUX_FILE_SPEC_CYGWIN';
  package File::Spec::Cygwin;
  
  use strict;
  use vars qw(@ISA $VERSION);
  require File::Spec::Unix;
  
  $VERSION = '3.40';
  $VERSION =~ tr/_//;
  
  @ISA = qw(File::Spec::Unix);
  
  =head1 NAME
  
  File::Spec::Cygwin - methods for Cygwin file specs
  
  =head1 SYNOPSIS
  
   require File::Spec::Cygwin; # Done internally by File::Spec if needed
  
  =head1 DESCRIPTION
  
  See L<File::Spec> and L<File::Spec::Unix>.  This package overrides the
  implementation of these methods, not the semantics.
  
  This module is still in beta.  Cygwin-knowledgeable folks are invited
  to offer patches and suggestions.
  
  =cut
  
  =pod
  
  =over 4
  
  =item canonpath
  
  Any C<\> (backslashes) are converted to C</> (forward slashes),
  and then File::Spec::Unix canonpath() is called on the result.
  
  =cut
  
  sub canonpath {
      my($self,$path) = @_;
      return unless defined $path;
  
      $path =~ s|\\|/|g;
  
      # Handle network path names beginning with double slash
      my $node = '';
      if ( $path =~ s@^(//[^/]+)(?:/|\z)@/@s ) {
          $node = $1;
      }
      return $node . $self->SUPER::canonpath($path);
  }
  
  sub catdir {
      my $self = shift;
      return unless @_;
  
      # Don't create something that looks like a //network/path
      if ($_[0] and ($_[0] eq '/' or $_[0] eq '\\')) {
          shift;
          return $self->SUPER::catdir('', @_);
      }
  
      $self->SUPER::catdir(@_);
  }
  
  =pod
  
  =item file_name_is_absolute
  
  True is returned if the file name begins with C<drive_letter:>,
  and if not, File::Spec::Unix file_name_is_absolute() is called.
  
  =cut
  
  
  sub file_name_is_absolute {
      my ($self,$file) = @_;
      return 1 if $file =~ m{^([a-z]:)?[\\/]}is; # C:/test
      return $self->SUPER::file_name_is_absolute($file);
  }
  
  =item tmpdir (override)
  
  Returns a string representation of the first existing directory
  from the following list:
  
      $ENV{TMPDIR}
      /tmp
      $ENV{'TMP'}
      $ENV{'TEMP'}
      C:/temp
  
  Since Perl 5.8.0, if running under taint mode, and if the environment
  variables are tainted, they are not used.
  
  =cut
  
  my $tmpdir;
  sub tmpdir {
      return $tmpdir if defined $tmpdir;
      $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR}, "/tmp", $ENV{'TMP'}, $ENV{'TEMP'}, 'C:/temp' );
  }
  
  =item case_tolerant
  
  Override Unix. Cygwin case-tolerance depends on managed mount settings and
  as with MsWin32 on GetVolumeInformation() $ouFsFlags == FS_CASE_SENSITIVE,
  indicating the case significance when comparing file specifications.
  Default: 1
  
  =cut
  
  sub case_tolerant {
    return 1 unless $^O eq 'cygwin'
      and defined &Cygwin::mount_flags;
  
    my $drive = shift;
    if (! $drive) {
        my @flags = split(/,/, Cygwin::mount_flags('/cygwin'));
        my $prefix = pop(@flags);
        if (! $prefix || $prefix eq 'cygdrive') {
            $drive = '/cygdrive/c';
        } elsif ($prefix eq '/') {
            $drive = '/c';
        } else {
            $drive = "$prefix/c";
        }
    }
    my $mntopts = Cygwin::mount_flags($drive);
    if ($mntopts and ($mntopts =~ /,managed/)) {
      return 0;
    }
    eval { require Win32API::File; } or return 1;
    my $osFsType = "\0"x256;
    my $osVolName = "\0"x256;
    my $ouFsFlags = 0;
    Win32API::File::GetVolumeInformation($drive, $osVolName, 256, [], [], $ouFsFlags, $osFsType, 256 );
    if ($ouFsFlags & Win32API::File::FS_CASE_SENSITIVE()) { return 0; }
    else { return 1; }
  }
  
  =back
  
  =head1 COPYRIGHT
  
  Copyright (c) 2004,2007 by the Perl 5 Porters.  All rights reserved.
  
  This program is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself.
  
  =cut
  
  1;
X86_64-LINUX_FILE_SPEC_CYGWIN

$fatpacked{"x86_64-linux/File/Spec/Epoc.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'X86_64-LINUX_FILE_SPEC_EPOC';
  package File::Spec::Epoc;
  
  use strict;
  use vars qw($VERSION @ISA);
  
  $VERSION = '3.40';
  $VERSION =~ tr/_//;
  
  require File::Spec::Unix;
  @ISA = qw(File::Spec::Unix);
  
  =head1 NAME
  
  File::Spec::Epoc - methods for Epoc file specs
  
  =head1 SYNOPSIS
  
   require File::Spec::Epoc; # Done internally by File::Spec if needed
  
  =head1 DESCRIPTION
  
  See File::Spec::Unix for a documentation of the methods provided
  there. This package overrides the implementation of these methods, not
  the semantics.
  
  This package is still work in progress ;-)
  
  =cut
  
  sub case_tolerant {
      return 1;
  }
  
  =pod
  
  =over 4
  
  =item canonpath()
  
  No physical check on the filesystem, but a logical cleanup of a
  path. On UNIX eliminated successive slashes and successive "/.".
  
  =back
  
  =cut
  
  sub canonpath {
      my ($self,$path) = @_;
      return unless defined $path;
  
      $path =~ s|/+|/|g;                             # xx////xx  -> xx/xx
      $path =~ s|(/\.)+/|/|g;                        # xx/././xx -> xx/xx
      $path =~ s|^(\./)+||s unless $path eq "./";    # ./xx      -> xx
      $path =~ s|^/(\.\./)+|/|s;                     # /../../xx -> xx
      $path =~  s|/\Z(?!\n)|| unless $path eq "/";          # xx/       -> xx
      return $path;
  }
  
  =pod
  
  =head1 AUTHOR
  
  o.flebbe@gmx.de
  
  =head1 COPYRIGHT
  
  Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
  
  This program is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself.
  
  =head1 SEE ALSO
  
  See L<File::Spec> and L<File::Spec::Unix>.  This package overrides the
  implementation of these methods, not the semantics.
  
  =cut
  
  1;
X86_64-LINUX_FILE_SPEC_EPOC

$fatpacked{"x86_64-linux/File/Spec/Functions.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'X86_64-LINUX_FILE_SPEC_FUNCTIONS';
  package File::Spec::Functions;
  
  use File::Spec;
  use strict;
  
  use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
  
  $VERSION = '3.40';
  $VERSION =~ tr/_//;
  
  require Exporter;
  
  @ISA = qw(Exporter);
  
  @EXPORT = qw(
  	canonpath
  	catdir
  	catfile
  	curdir
  	rootdir
  	updir
  	no_upwards
  	file_name_is_absolute
  	path
  );
  
  @EXPORT_OK = qw(
  	devnull
  	tmpdir
  	splitpath
  	splitdir
  	catpath
  	abs2rel
  	rel2abs
  	case_tolerant
  );
  
  %EXPORT_TAGS = ( ALL => [ @EXPORT_OK, @EXPORT ] );
  
  foreach my $meth (@EXPORT, @EXPORT_OK) {
      my $sub = File::Spec->can($meth);
      no strict 'refs';
      *{$meth} = sub {&$sub('File::Spec', @_)};
  }
  
  
  1;
  __END__
  
  =head1 NAME
  
  File::Spec::Functions - portably perform operations on file names
  
  =head1 SYNOPSIS
  
  	use File::Spec::Functions;
  	$x = catfile('a','b');
  
  =head1 DESCRIPTION
  
  This module exports convenience functions for all of the class methods
  provided by File::Spec.
  
  For a reference of available functions, please consult L<File::Spec::Unix>,
  which contains the entire set, and which is inherited by the modules for
  other platforms. For further information, please see L<File::Spec::Mac>,
  L<File::Spec::OS2>, L<File::Spec::Win32>, or L<File::Spec::VMS>.
  
  =head2 Exports
  
  The following functions are exported by default.
  
  	canonpath
  	catdir
  	catfile
  	curdir
  	rootdir
  	updir
  	no_upwards
  	file_name_is_absolute
  	path
  
  
  The following functions are exported only by request.
  
  	devnull
  	tmpdir
  	splitpath
  	splitdir
  	catpath
  	abs2rel
  	rel2abs
  	case_tolerant
  
  All the functions may be imported using the C<:ALL> tag.
  
  =head1 COPYRIGHT
  
  Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
  
  This program is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself.
  
  =head1 SEE ALSO
  
  File::Spec, File::Spec::Unix, File::Spec::Mac, File::Spec::OS2,
  File::Spec::Win32, File::Spec::VMS, ExtUtils::MakeMaker
  
  =cut
  
X86_64-LINUX_FILE_SPEC_FUNCTIONS

$fatpacked{"x86_64-linux/File/Spec/Mac.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'X86_64-LINUX_FILE_SPEC_MAC';
  package File::Spec::Mac;
  
  use strict;
  use vars qw(@ISA $VERSION);
  require File::Spec::Unix;
  
  $VERSION = '3.40';
  $VERSION =~ tr/_//;
  
  @ISA = qw(File::Spec::Unix);
  
  my $macfiles;
  if ($^O eq 'MacOS') {
  	$macfiles = eval { require Mac::Files };
  }
  
  sub case_tolerant { 1 }
  
  
  =head1 NAME
  
  File::Spec::Mac - File::Spec for Mac OS (Classic)
  
  =head1 SYNOPSIS
  
   require File::Spec::Mac; # Done internally by File::Spec if needed
  
  =head1 DESCRIPTION
  
  Methods for manipulating file specifications.
  
  =head1 METHODS
  
  =over 2
  
  =item canonpath
  
  On Mac OS, there's nothing to be done. Returns what it's given.
  
  =cut
  
  sub canonpath {
      my ($self,$path) = @_;
      return $path;
  }
  
  =item catdir()
  
  Concatenate two or more directory names to form a path separated by colons
  (":") ending with a directory. Resulting paths are B<relative> by default,
  but can be forced to be absolute (but avoid this, see below). Automatically
  puts a trailing ":" on the end of the complete path, because that's what's
  done in MacPerl's environment and helps to distinguish a file path from a
  directory path.
  
  B<IMPORTANT NOTE:> Beginning with version 1.3 of this module, the resulting
  path is relative by default and I<not> absolute. This decision was made due
  to portability reasons. Since C<File::Spec-E<gt>catdir()> returns relative paths
  on all other operating systems, it will now also follow this convention on Mac
  OS. Note that this may break some existing scripts.
  
  The intended purpose of this routine is to concatenate I<directory names>.
  But because of the nature of Macintosh paths, some additional possibilities
  are allowed to make using this routine give reasonable results for some
  common situations. In other words, you are also allowed to concatenate
  I<paths> instead of directory names (strictly speaking, a string like ":a"
  is a path, but not a name, since it contains a punctuation character ":").
  
  So, beside calls like
  
      catdir("a") = ":a:"
      catdir("a","b") = ":a:b:"
      catdir() = ""                    (special case)
  
  calls like the following
  
      catdir(":a:") = ":a:"
      catdir(":a","b") = ":a:b:"
      catdir(":a:","b") = ":a:b:"
      catdir(":a:",":b:") = ":a:b:"
      catdir(":") = ":"
  
  are allowed.
  
  Here are the rules that are used in C<catdir()>; note that we try to be as
  compatible as possible to Unix:
  
  =over 2
  
  =item 1.
  
  The resulting path is relative by default, i.e. the resulting path will have a
  leading colon.
  
  =item 2.
  
  A trailing colon is added automatically to the resulting path, to denote a
  directory.
  
  =item 3.
  
  Generally, each argument has one leading ":" and one trailing ":"
  removed (if any). They are then joined together by a ":". Special
  treatment applies for arguments denoting updir paths like "::lib:",
  see (4), or arguments consisting solely of colons ("colon paths"),
  see (5).
  
  =item 4.
  
  When an updir path like ":::lib::" is passed as argument, the number
  of directories to climb up is handled correctly, not removing leading
  or trailing colons when necessary. E.g.
  
      catdir(":::a","::b","c")    = ":::a::b:c:"
      catdir(":::a::","::b","c")  = ":::a:::b:c:"
  
  =item 5.
  
  Adding a colon ":" or empty string "" to a path at I<any> position
  doesn't alter the path, i.e. these arguments are ignored. (When a ""
  is passed as the first argument, it has a special meaning, see
  (6)). This way, a colon ":" is handled like a "." (curdir) on Unix,
  while an empty string "" is generally ignored (see
  C<Unix-E<gt>canonpath()> ). Likewise, a "::" is handled like a ".."
  (updir), and a ":::" is handled like a "../.." etc.  E.g.
  
      catdir("a",":",":","b")   = ":a:b:"
      catdir("a",":","::",":b") = ":a::b:"
  
  =item 6.
  
  If the first argument is an empty string "" or is a volume name, i.e. matches
  the pattern /^[^:]+:/, the resulting path is B<absolute>.
  
  =item 7.
  
  Passing an empty string "" as the first argument to C<catdir()> is
  like passingC<File::Spec-E<gt>rootdir()> as the first argument, i.e.
  
      catdir("","a","b")          is the same as
  
      catdir(rootdir(),"a","b").
  
  This is true on Unix, where C<catdir("","a","b")> yields "/a/b" and
  C<rootdir()> is "/". Note that C<rootdir()> on Mac OS is the startup
  volume, which is the closest in concept to Unix' "/". This should help
  to run existing scripts originally written for Unix.
  
  =item 8.
  
  For absolute paths, some cleanup is done, to ensure that the volume
  name isn't immediately followed by updirs. This is invalid, because
  this would go beyond "root". Generally, these cases are handled like
  their Unix counterparts:
  
   Unix:
      Unix->catdir("","")                 =  "/"
      Unix->catdir("",".")                =  "/"
      Unix->catdir("","..")               =  "/"        # can't go
                                                        # beyond root
      Unix->catdir("",".","..","..","a")  =  "/a"
   Mac:
      Mac->catdir("","")                  =  rootdir()  # (e.g. "HD:")
      Mac->catdir("",":")                 =  rootdir()
      Mac->catdir("","::")                =  rootdir()  # can't go
                                                        # beyond root
      Mac->catdir("",":","::","::","a")   =  rootdir() . "a:"
                                                      # (e.g. "HD:a:")
  
  However, this approach is limited to the first arguments following
  "root" (again, see C<Unix-E<gt>canonpath()> ). If there are more
  arguments that move up the directory tree, an invalid path going
  beyond root can be created.
  
  =back
  
  As you've seen, you can force C<catdir()> to create an absolute path
  by passing either an empty string or a path that begins with a volume
  name as the first argument. However, you are strongly encouraged not
  to do so, since this is done only for backward compatibility. Newer
  versions of File::Spec come with a method called C<catpath()> (see
  below), that is designed to offer a portable solution for the creation
  of absolute paths.  It takes volume, directory and file portions and
  returns an entire path. While C<catdir()> is still suitable for the
  concatenation of I<directory names>, you are encouraged to use
  C<catpath()> to concatenate I<volume names> and I<directory
  paths>. E.g.
  
      $dir      = File::Spec->catdir("tmp","sources");
      $abs_path = File::Spec->catpath("MacintoshHD:", $dir,"");
  
  yields
  
      "MacintoshHD:tmp:sources:" .
  
  =cut
  
  sub catdir {
  	my $self = shift;
  	return '' unless @_;
  	my @args = @_;
  	my $first_arg;
  	my $relative;
  
  	# take care of the first argument
  
  	if ($args[0] eq '')  { # absolute path, rootdir
  		shift @args;
  		$relative = 0;
  		$first_arg = $self->rootdir;
  
  	} elsif ($args[0] =~ /^[^:]+:/) { # absolute path, volume name
  		$relative = 0;
  		$first_arg = shift @args;
  		# add a trailing ':' if need be (may be it's a path like HD:dir)
  		$first_arg = "$first_arg:" unless ($first_arg =~ /:\Z(?!\n)/);
  
  	} else { # relative path
  		$relative = 1;
  		if ( $args[0] =~ /^::+\Z(?!\n)/ ) {
  			# updir colon path ('::', ':::' etc.), don't shift
  			$first_arg = ':';
  		} elsif ($args[0] eq ':') {
  			$first_arg = shift @args;
  		} else {
  			# add a trailing ':' if need be
  			$first_arg = shift @args;
  			$first_arg = "$first_arg:" unless ($first_arg =~ /:\Z(?!\n)/);
  		}
  	}
  
  	# For all other arguments,
  	# (a) ignore arguments that equal ':' or '',
  	# (b) handle updir paths specially:
  	#     '::' 			-> concatenate '::'
  	#     '::' . '::' 	-> concatenate ':::' etc.
  	# (c) add a trailing ':' if need be
  
  	my $result = $first_arg;
  	while (@args) {
  		my $arg = shift @args;
  		unless (($arg eq '') || ($arg eq ':')) {
  			if ($arg =~ /^::+\Z(?!\n)/ ) { # updir colon path like ':::'
  				my $updir_count = length($arg) - 1;
  				while ((@args) && ($args[0] =~ /^::+\Z(?!\n)/) ) { # while updir colon path
  					$arg = shift @args;
  					$updir_count += (length($arg) - 1);
  				}
  				$arg = (':' x $updir_count);
  			} else {
  				$arg =~ s/^://s; # remove a leading ':' if any
  				$arg = "$arg:" unless ($arg =~ /:\Z(?!\n)/); # ensure trailing ':'
  			}
  			$result .= $arg;
  		}#unless
  	}
  
  	if ( ($relative) && ($result !~ /^:/) ) {
  		# add a leading colon if need be
  		$result = ":$result";
  	}
  
  	unless ($relative) {
  		# remove updirs immediately following the volume name
  		$result =~ s/([^:]+:)(:*)(.*)\Z(?!\n)/$1$3/;
  	}
  
  	return $result;
  }
  
  =item catfile
  
  Concatenate one or more directory names and a filename to form a
  complete path ending with a filename. Resulting paths are B<relative>
  by default, but can be forced to be absolute (but avoid this).
  
  B<IMPORTANT NOTE:> Beginning with version 1.3 of this module, the
  resulting path is relative by default and I<not> absolute. This
  decision was made due to portability reasons. Since
  C<File::Spec-E<gt>catfile()> returns relative paths on all other
  operating systems, it will now also follow this convention on Mac OS.
  Note that this may break some existing scripts.
  
  The last argument is always considered to be the file portion. Since
  C<catfile()> uses C<catdir()> (see above) for the concatenation of the
  directory portions (if any), the following with regard to relative and
  absolute paths is true:
  
      catfile("")     = ""
      catfile("file") = "file"
  
  but
  
      catfile("","")        = rootdir()         # (e.g. "HD:")
      catfile("","file")    = rootdir() . file  # (e.g. "HD:file")
      catfile("HD:","file") = "HD:file"
  
  This means that C<catdir()> is called only when there are two or more
  arguments, as one might expect.
  
  Note that the leading ":" is removed from the filename, so that
  
      catfile("a","b","file")  = ":a:b:file"    and
  
      catfile("a","b",":file") = ":a:b:file"
  
  give the same answer.
  
  To concatenate I<volume names>, I<directory paths> and I<filenames>,
  you are encouraged to use C<catpath()> (see below).
  
  =cut
  
  sub catfile {
      my $self = shift;
      return '' unless @_;
      my $file = pop @_;
      return $file unless @_;
      my $dir = $self->catdir(@_);
      $file =~ s/^://s;
      return $dir.$file;
  }
  
  =item curdir
  
  Returns a string representing the current directory. On Mac OS, this is ":".
  
  =cut
  
  sub curdir {
      return ":";
  }
  
  =item devnull
  
  Returns a string representing the null device. On Mac OS, this is "Dev:Null".
  
  =cut
  
  sub devnull {
      return "Dev:Null";
  }
  
  =item rootdir
  
  Returns a string representing the root directory.  Under MacPerl,
  returns the name of the startup volume, since that's the closest in
  concept, although other volumes aren't rooted there. The name has a
  trailing ":", because that's the correct specification for a volume
  name on Mac OS.
  
  If Mac::Files could not be loaded, the empty string is returned.
  
  =cut
  
  sub rootdir {
  #
  #  There's no real root directory on Mac OS. The name of the startup
  #  volume is returned, since that's the closest in concept.
  #
      return '' unless $macfiles;
      my $system = Mac::Files::FindFolder(&Mac::Files::kOnSystemDisk,
  	&Mac::Files::kSystemFolderType);
      $system =~ s/:.*\Z(?!\n)/:/s;
      return $system;
  }
  
  =item tmpdir
  
  Returns the contents of $ENV{TMPDIR}, if that directory exits or the
  current working directory otherwise. Under MacPerl, $ENV{TMPDIR} will
  contain a path like "MacintoshHD:Temporary Items:", which is a hidden
  directory on your startup volume.
  
  =cut
  
  my $tmpdir;
  sub tmpdir {
      return $tmpdir if defined $tmpdir;
      $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR} );
  }
  
  =item updir
  
  Returns a string representing the parent directory. On Mac OS, this is "::".
  
  =cut
  
  sub updir {
      return "::";
  }
  
  =item file_name_is_absolute
  
  Takes as argument a path and returns true, if it is an absolute path.
  If the path has a leading ":", it's a relative path. Otherwise, it's an
  absolute path, unless the path doesn't contain any colons, i.e. it's a name
  like "a". In this particular case, the path is considered to be relative
  (i.e. it is considered to be a filename). Use ":" in the appropriate place
  in the path if you want to distinguish unambiguously. As a special case,
  the filename '' is always considered to be absolute. Note that with version
  1.2 of File::Spec::Mac, this does no longer consult the local filesystem.
  
  E.g.
  
      File::Spec->file_name_is_absolute("a");         # false (relative)
      File::Spec->file_name_is_absolute(":a:b:");     # false (relative)
      File::Spec->file_name_is_absolute("MacintoshHD:");
                                                      # true (absolute)
      File::Spec->file_name_is_absolute("");          # true (absolute)
  
  
  =cut
  
  sub file_name_is_absolute {
      my ($self,$file) = @_;
      if ($file =~ /:/) {
  	return (! ($file =~ m/^:/s) );
      } elsif ( $file eq '' ) {
          return 1 ;
      } else {
  	return 0; # i.e. a file like "a"
      }
  }
  
  =item path
  
  Returns the null list for the MacPerl application, since the concept is
  usually meaningless under Mac OS. But if you're using the MacPerl tool under
  MPW, it gives back $ENV{Commands} suitably split, as is done in
  :lib:ExtUtils:MM_Mac.pm.
  
  =cut
  
  sub path {
  #
  #  The concept is meaningless under the MacPerl application.
  #  Under MPW, it has a meaning.
  #
      return unless exists $ENV{Commands};
      return split(/,/, $ENV{Commands});
  }
  
  =item splitpath
  
      ($volume,$directories,$file) = File::Spec->splitpath( $path );
      ($volume,$directories,$file) = File::Spec->splitpath( $path,
                                                            $no_file );
  
  Splits a path into volume, directory, and filename portions.
  
  On Mac OS, assumes that the last part of the path is a filename unless
  $no_file is true or a trailing separator ":" is present.
  
  The volume portion is always returned with a trailing ":". The directory portion
  is always returned with a leading (to denote a relative path) and a trailing ":"
  (to denote a directory). The file portion is always returned I<without> a leading ":".
  Empty portions are returned as empty string ''.
  
  The results can be passed to C<catpath()> to get back a path equivalent to
  (usually identical to) the original path.
  
  
  =cut
  
  sub splitpath {
      my ($self,$path, $nofile) = @_;
      my ($volume,$directory,$file);
  
      if ( $nofile ) {
          ( $volume, $directory ) = $path =~ m|^((?:[^:]+:)?)(.*)|s;
      }
      else {
          $path =~
              m|^( (?: [^:]+: )? )
                 ( (?: .*: )? )
                 ( .* )
               |xs;
          $volume    = $1;
          $directory = $2;
          $file      = $3;
      }
  
      $volume = '' unless defined($volume);
  	$directory = ":$directory" if ( $volume && $directory ); # take care of "HD::dir"
      if ($directory) {
          # Make sure non-empty directories begin and end in ':'
          $directory .= ':' unless (substr($directory,-1) eq ':');
          $directory = ":$directory" unless (substr($directory,0,1) eq ':');
      } else {
  	$directory = '';
      }
      $file = '' unless defined($file);
  
      return ($volume,$directory,$file);
  }
  
  
  =item splitdir
  
  The opposite of C<catdir()>.
  
      @dirs = File::Spec->splitdir( $directories );
  
  $directories should be only the directory portion of the path on systems
  that have the concept of a volume or that have path syntax that differentiates
  files from directories. Consider using C<splitpath()> otherwise.
  
  Unlike just splitting the directories on the separator, empty directory names
  (C<"">) can be returned. Since C<catdir()> on Mac OS always appends a trailing
  colon to distinguish a directory path from a file path, a single trailing colon
  will be ignored, i.e. there's no empty directory name after it.
  
  Hence, on Mac OS, both
  
      File::Spec->splitdir( ":a:b::c:" );    and
      File::Spec->splitdir( ":a:b::c" );
  
  yield:
  
      ( "a", "b", "::", "c")
  
  while
  
      File::Spec->splitdir( ":a:b::c::" );
  
  yields:
  
      ( "a", "b", "::", "c", "::")
  
  
  =cut
  
  sub splitdir {
  	my ($self, $path) = @_;
  	my @result = ();
  	my ($head, $sep, $tail, $volume, $directories);
  
  	return @result if ( (!defined($path)) || ($path eq '') );
  	return (':') if ($path eq ':');
  
  	( $volume, $sep, $directories ) = $path =~ m|^((?:[^:]+:)?)(:*)(.*)|s;
  
  	# deprecated, but handle it correctly
  	if ($volume) {
  		push (@result, $volume);
  		$sep .= ':';
  	}
  
  	while ($sep || $directories) {
  		if (length($sep) > 1) {
  			my $updir_count = length($sep) - 1;
  			for (my $i=0; $i<$updir_count; $i++) {
  				# push '::' updir_count times;
  				# simulate Unix '..' updirs
  				push (@result, '::');
  			}
  		}
  		$sep = '';
  		if ($directories) {
  			( $head, $sep, $tail ) = $directories =~ m|^((?:[^:]+)?)(:*)(.*)|s;
  			push (@result, $head);
  			$directories = $tail;
  		}
  	}
  	return @result;
  }
  
  
  =item catpath
  
      $path = File::Spec->catpath($volume,$directory,$file);
  
  Takes volume, directory and file portions and returns an entire path. On Mac OS,
  $volume, $directory and $file are concatenated.  A ':' is inserted if need be. You
  may pass an empty string for each portion. If all portions are empty, the empty
  string is returned. If $volume is empty, the result will be a relative path,
  beginning with a ':'. If $volume and $directory are empty, a leading ":" (if any)
  is removed form $file and the remainder is returned. If $file is empty, the
  resulting path will have a trailing ':'.
  
  
  =cut
  
  sub catpath {
      my ($self,$volume,$directory,$file) = @_;
  
      if ( (! $volume) && (! $directory) ) {
  	$file =~ s/^:// if $file;
  	return $file ;
      }
  
      # We look for a volume in $volume, then in $directory, but not both
  
      my ($dir_volume, $dir_dirs) = $self->splitpath($directory, 1);
  
      $volume = $dir_volume unless length $volume;
      my $path = $volume; # may be ''
      $path .= ':' unless (substr($path, -1) eq ':'); # ensure trailing ':'
  
      if ($directory) {
  	$directory = $dir_dirs if $volume;
  	$directory =~ s/^://; # remove leading ':' if any
  	$path .= $directory;
  	$path .= ':' unless (substr($path, -1) eq ':'); # ensure trailing ':'
      }
  
      if ($file) {
  	$file =~ s/^://; # remove leading ':' if any
  	$path .= $file;
      }
  
      return $path;
  }
  
  =item abs2rel
  
  Takes a destination path and an optional base path and returns a relative path
  from the base path to the destination path:
  
      $rel_path = File::Spec->abs2rel( $path ) ;
      $rel_path = File::Spec->abs2rel( $path, $base ) ;
  
  Note that both paths are assumed to have a notation that distinguishes a
  directory path (with trailing ':') from a file path (without trailing ':').
  
  If $base is not present or '', then the current working directory is used.
  If $base is relative, then it is converted to absolute form using C<rel2abs()>.
  This means that it is taken to be relative to the current working directory.
  
  If $path and $base appear to be on two different volumes, we will not
  attempt to resolve the two paths, and we will instead simply return
  $path.  Note that previous versions of this module ignored the volume
  of $base, which resulted in garbage results part of the time.
  
  If $base doesn't have a trailing colon, the last element of $base is
  assumed to be a filename.  This filename is ignored.  Otherwise all path
  components are assumed to be directories.
  
  If $path is relative, it is converted to absolute form using C<rel2abs()>.
  This means that it is taken to be relative to the current working directory.
  
  Based on code written by Shigio Yamaguchi.
  
  
  =cut
  
  # maybe this should be done in canonpath() ?
  sub _resolve_updirs {
  	my $path = shift @_;
  	my $proceed;
  
  	# resolve any updirs, e.g. "HD:tmp::file" -> "HD:file"
  	do {
  		$proceed = ($path =~ s/^(.*):[^:]+::(.*?)\z/$1:$2/);
  	} while ($proceed);
  
  	return $path;
  }
  
  
  sub abs2rel {
      my($self,$path,$base) = @_;
  
      # Clean up $path
      if ( ! $self->file_name_is_absolute( $path ) ) {
          $path = $self->rel2abs( $path ) ;
      }
  
      # Figure out the effective $base and clean it up.
      if ( !defined( $base ) || $base eq '' ) {
  	$base = $self->_cwd();
      }
      elsif ( ! $self->file_name_is_absolute( $base ) ) {
          $base = $self->rel2abs( $base ) ;
  	$base = _resolve_updirs( $base ); # resolve updirs in $base
      }
      else {
  	$base = _resolve_updirs( $base );
      }
  
      # Split up paths - ignore $base's file
      my ( $path_vol, $path_dirs, $path_file ) =  $self->splitpath( $path );
      my ( $base_vol, $base_dirs )             =  $self->splitpath( $base );
  
      return $path unless lc( $path_vol ) eq lc( $base_vol );
  
      # Now, remove all leading components that are the same
      my @pathchunks = $self->splitdir( $path_dirs );
      my @basechunks = $self->splitdir( $base_dirs );
  	
      while ( @pathchunks &&
  	    @basechunks &&
  	    lc( $pathchunks[0] ) eq lc( $basechunks[0] ) ) {
          shift @pathchunks ;
          shift @basechunks ;
      }
  
      # @pathchunks now has the directories to descend in to.
      # ensure relative path, even if @pathchunks is empty
      $path_dirs = $self->catdir( ':', @pathchunks );
  
      # @basechunks now contains the number of directories to climb out of.
      $base_dirs = (':' x @basechunks) . ':' ;
  
      return $self->catpath( '', $self->catdir( $base_dirs, $path_dirs ), $path_file ) ;
  }
  
  =item rel2abs
  
  Converts a relative path to an absolute path:
  
      $abs_path = File::Spec->rel2abs( $path ) ;
      $abs_path = File::Spec->rel2abs( $path, $base ) ;
  
  Note that both paths are assumed to have a notation that distinguishes a
  directory path (with trailing ':') from a file path (without trailing ':').
  
  If $base is not present or '', then $base is set to the current working
  directory. If $base is relative, then it is converted to absolute form
  using C<rel2abs()>. This means that it is taken to be relative to the
  current working directory.
  
  If $base doesn't have a trailing colon, the last element of $base is
  assumed to be a filename.  This filename is ignored.  Otherwise all path
  components are assumed to be directories.
  
  If $path is already absolute, it is returned and $base is ignored.
  
  Based on code written by Shigio Yamaguchi.
  
  =cut
  
  sub rel2abs {
      my ($self,$path,$base) = @_;
  
      if ( ! $self->file_name_is_absolute($path) ) {
          # Figure out the effective $base and clean it up.
          if ( !defined( $base ) || $base eq '' ) {
  	    $base = $self->_cwd();
          }
          elsif ( ! $self->file_name_is_absolute($base) ) {
              $base = $self->rel2abs($base) ;
          }
  
  	# Split up paths
  
  	# ignore $path's volume
          my ( $path_dirs, $path_file ) = ($self->splitpath($path))[1,2] ;
  
          # ignore $base's file part
  	my ( $base_vol, $base_dirs ) = $self->splitpath($base) ;
  
  	# Glom them together
  	$path_dirs = ':' if ($path_dirs eq '');
  	$base_dirs =~ s/:$//; # remove trailing ':', if any
  	$base_dirs = $base_dirs . $path_dirs;
  
          $path = $self->catpath( $base_vol, $base_dirs, $path_file );
      }
      return $path;
  }
  
  
  =back
  
  =head1 AUTHORS
  
  See the authors list in I<File::Spec>. Mac OS support by Paul Schinder
  <schinder@pobox.com> and Thomas Wegner <wegner_thomas@yahoo.com>.
  
  =head1 COPYRIGHT
  
  Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
  
  This program is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself.
  
  =head1 SEE ALSO
  
  See L<File::Spec> and L<File::Spec::Unix>.  This package overrides the
  implementation of these methods, not the semantics.
  
  =cut
  
  1;
X86_64-LINUX_FILE_SPEC_MAC

$fatpacked{"x86_64-linux/File/Spec/OS2.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'X86_64-LINUX_FILE_SPEC_OS2';
  package File::Spec::OS2;
  
  use strict;
  use vars qw(@ISA $VERSION);
  require File::Spec::Unix;
  
  $VERSION = '3.40';
  $VERSION =~ tr/_//;
  
  @ISA = qw(File::Spec::Unix);
  
  sub devnull {
      return "/dev/nul";
  }
  
  sub case_tolerant {
      return 1;
  }
  
  sub file_name_is_absolute {
      my ($self,$file) = @_;
      return scalar($file =~ m{^([a-z]:)?[\\/]}is);
  }
  
  sub path {
      my $path = $ENV{PATH};
      $path =~ s:\\:/:g;
      my @path = split(';',$path);
      foreach (@path) { $_ = '.' if $_ eq '' }
      return @path;
  }
  
  sub _cwd {
      # In OS/2 the "require Cwd" is unnecessary bloat.
      return Cwd::sys_cwd();
  }
  
  my $tmpdir;
  sub tmpdir {
      return $tmpdir if defined $tmpdir;
      my @d = @ENV{qw(TMPDIR TEMP TMP)};	# function call could autovivivy
      $tmpdir = $_[0]->_tmpdir( @d, '/tmp', '/'  );
  }
  
  sub catdir {
      my $self = shift;
      my @args = @_;
      foreach (@args) {
  	tr[\\][/];
          # append a backslash to each argument unless it has one there
          $_ .= "/" unless m{/$};
      }
      return $self->canonpath(join('', @args));
  }
  
  sub canonpath {
      my ($self,$path) = @_;
      return unless defined $path;
  
      $path =~ s/^([a-z]:)/\l$1/s;
      $path =~ s|\\|/|g;
      $path =~ s|([^/])/+|$1/|g;                  # xx////xx  -> xx/xx
      $path =~ s|(/\.)+/|/|g;                     # xx/././xx -> xx/xx
      $path =~ s|^(\./)+(?=[^/])||s;		# ./xx      -> xx
      $path =~ s|/\Z(?!\n)||
               unless $path =~ m#^([a-z]:)?/\Z(?!\n)#si;# xx/       -> xx
      $path =~ s{^/\.\.$}{/};                     # /..    -> /
      1 while $path =~ s{^/\.\.}{};               # /../xx -> /xx
      return $path;
  }
  
  
  sub splitpath {
      my ($self,$path, $nofile) = @_;
      my ($volume,$directory,$file) = ('','','');
      if ( $nofile ) {
          $path =~ 
              m{^( (?:[a-zA-Z]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? ) 
                   (.*)
               }xs;
          $volume    = $1;
          $directory = $2;
      }
      else {
          $path =~ 
              m{^ ( (?: [a-zA-Z]: |
                        (?:\\\\|//)[^\\/]+[\\/][^\\/]+
                    )?
                  )
                  ( (?:.*[\\\\/](?:\.\.?\Z(?!\n))?)? )
                  (.*)
               }xs;
          $volume    = $1;
          $directory = $2;
          $file      = $3;
      }
  
      return ($volume,$directory,$file);
  }
  
  
  sub splitdir {
      my ($self,$directories) = @_ ;
      split m|[\\/]|, $directories, -1;
  }
  
  
  sub catpath {
      my ($self,$volume,$directory,$file) = @_;
  
      # If it's UNC, make sure the glue separator is there, reusing
      # whatever separator is first in the $volume
      $volume .= $1
          if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s &&
               $directory =~ m@^[^\\/]@s
             ) ;
  
      $volume .= $directory ;
  
      # If the volume is not just A:, make sure the glue separator is 
      # there, reusing whatever separator is first in the $volume if possible.
      if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s &&
           $volume =~ m@[^\\/]\Z(?!\n)@      &&
           $file   =~ m@[^\\/]@
         ) {
          $volume =~ m@([\\/])@ ;
          my $sep = $1 ? $1 : '/' ;
          $volume .= $sep ;
      }
  
      $volume .= $file ;
  
      return $volume ;
  }
  
  
  sub abs2rel {
      my($self,$path,$base) = @_;
  
      # Clean up $path
      if ( ! $self->file_name_is_absolute( $path ) ) {
          $path = $self->rel2abs( $path ) ;
      } else {
          $path = $self->canonpath( $path ) ;
      }
  
      # Figure out the effective $base and clean it up.
      if ( !defined( $base ) || $base eq '' ) {
  	$base = $self->_cwd();
      } elsif ( ! $self->file_name_is_absolute( $base ) ) {
          $base = $self->rel2abs( $base ) ;
      } else {
          $base = $self->canonpath( $base ) ;
      }
  
      # Split up paths
      my ( $path_volume, $path_directories, $path_file ) = $self->splitpath( $path, 1 ) ;
      my ( $base_volume, $base_directories ) = $self->splitpath( $base, 1 ) ;
      return $path unless $path_volume eq $base_volume;
  
      # Now, remove all leading components that are the same
      my @pathchunks = $self->splitdir( $path_directories );
      my @basechunks = $self->splitdir( $base_directories );
  
      while ( @pathchunks && 
              @basechunks && 
              lc( $pathchunks[0] ) eq lc( $basechunks[0] ) 
            ) {
          shift @pathchunks ;
          shift @basechunks ;
      }
  
      # No need to catdir, we know these are well formed.
      $path_directories = CORE::join( '/', @pathchunks );
      $base_directories = CORE::join( '/', @basechunks );
  
      # $base_directories now contains the directories the resulting relative
      # path must ascend out of before it can descend to $path_directory.  So, 
      # replace all names with $parentDir
  
      #FA Need to replace between backslashes...
      $base_directories =~ s|[^\\/]+|..|g ;
  
      # Glue the two together, using a separator if necessary, and preventing an
      # empty result.
  
      #FA Must check that new directories are not empty.
      if ( $path_directories ne '' && $base_directories ne '' ) {
          $path_directories = "$base_directories/$path_directories" ;
      } else {
          $path_directories = "$base_directories$path_directories" ;
      }
  
      return $self->canonpath( 
          $self->catpath( "", $path_directories, $path_file ) 
      ) ;
  }
  
  
  sub rel2abs {
      my ($self,$path,$base ) = @_;
  
      if ( ! $self->file_name_is_absolute( $path ) ) {
  
          if ( !defined( $base ) || $base eq '' ) {
  	    $base = $self->_cwd();
          }
          elsif ( ! $self->file_name_is_absolute( $base ) ) {
              $base = $self->rel2abs( $base ) ;
          }
          else {
              $base = $self->canonpath( $base ) ;
          }
  
          my ( $path_directories, $path_file ) =
              ($self->splitpath( $path, 1 ))[1,2] ;
  
          my ( $base_volume, $base_directories ) =
              $self->splitpath( $base, 1 ) ;
  
          $path = $self->catpath( 
              $base_volume, 
              $self->catdir( $base_directories, $path_directories ), 
              $path_file
          ) ;
      }
  
      return $self->canonpath( $path ) ;
  }
  
  1;
  __END__
  
  =head1 NAME
  
  File::Spec::OS2 - methods for OS/2 file specs
  
  =head1 SYNOPSIS
  
   require File::Spec::OS2; # Done internally by File::Spec if needed
  
  =head1 DESCRIPTION
  
  See L<File::Spec> and L<File::Spec::Unix>.  This package overrides the
  implementation of these methods, not the semantics.
  
  Amongst the changes made for OS/2 are...
  
  =over 4
  
  =item tmpdir
  
  Modifies the list of places temp directory information is looked for.
  
      $ENV{TMPDIR}
      $ENV{TEMP}
      $ENV{TMP}
      /tmp
      /
  
  =item splitpath
  
  Volumes can be drive letters or UNC sharenames (\\server\share).
  
  =back
  
  =head1 COPYRIGHT
  
  Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
  
  This program is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself.
  
  =cut
X86_64-LINUX_FILE_SPEC_OS2

$fatpacked{"x86_64-linux/File/Spec/Unix.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'X86_64-LINUX_FILE_SPEC_UNIX';
  package File::Spec::Unix;
  
  use strict;
  use vars qw($VERSION);
  
  $VERSION = '3.40';
  $VERSION =~ tr/_//;
  
  =head1 NAME
  
  File::Spec::Unix - File::Spec for Unix, base for other File::Spec modules
  
  =head1 SYNOPSIS
  
   require File::Spec::Unix; # Done automatically by File::Spec
  
  =head1 DESCRIPTION
  
  Methods for manipulating file specifications.  Other File::Spec
  modules, such as File::Spec::Mac, inherit from File::Spec::Unix and
  override specific methods.
  
  =head1 METHODS
  
  =over 2
  
  =item canonpath()
  
  No physical check on the filesystem, but a logical cleanup of a
  path. On UNIX eliminates successive slashes and successive "/.".
  
      $cpath = File::Spec->canonpath( $path ) ;
  
  Note that this does *not* collapse F<x/../y> sections into F<y>.  This
  is by design.  If F</foo> on your system is a symlink to F</bar/baz>,
  then F</foo/../quux> is actually F</bar/quux>, not F</quux> as a naive
  F<../>-removal would give you.  If you want to do this kind of
  processing, you probably want C<Cwd>'s C<realpath()> function to
  actually traverse the filesystem cleaning up paths like this.
  
  =cut
  
  sub canonpath {
      my ($self,$path) = @_;
      return unless defined $path;
      
      # Handle POSIX-style node names beginning with double slash (qnx, nto)
      # (POSIX says: "a pathname that begins with two successive slashes
      # may be interpreted in an implementation-defined manner, although
      # more than two leading slashes shall be treated as a single slash.")
      my $node = '';
      my $double_slashes_special = $^O eq 'qnx' || $^O eq 'nto';
  
  
      if ( $double_slashes_special
           && ( $path =~ s{^(//[^/]+)/?\z}{}s || $path =~ s{^(//[^/]+)/}{/}s ) ) {
        $node = $1;
      }
      # This used to be
      # $path =~ s|/+|/|g unless ($^O eq 'cygwin');
      # but that made tests 29, 30, 35, 46, and 213 (as of #13272) to fail
      # (Mainly because trailing "" directories didn't get stripped).
      # Why would cygwin avoid collapsing multiple slashes into one? --jhi
      $path =~ s|/{2,}|/|g;                            # xx////xx  -> xx/xx
      $path =~ s{(?:/\.)+(?:/|\z)}{/}g;                # xx/././xx -> xx/xx
      $path =~ s|^(?:\./)+||s unless $path eq "./";    # ./xx      -> xx
      $path =~ s|^/(?:\.\./)+|/|;                      # /../../xx -> xx
      $path =~ s|^/\.\.$|/|;                         # /..       -> /
      $path =~ s|/\z|| unless $path eq "/";          # xx/       -> xx
      return "$node$path";
  }
  
  =item catdir()
  
  Concatenate two or more directory names to form a complete path ending
  with a directory. But remove the trailing slash from the resulting
  string, because it doesn't look good, isn't necessary and confuses
  OS2. Of course, if this is the root directory, don't cut off the
  trailing slash :-)
  
  =cut
  
  sub catdir {
      my $self = shift;
  
      $self->canonpath(join('/', @_, '')); # '' because need a trailing '/'
  }
  
  =item catfile
  
  Concatenate one or more directory names and a filename to form a
  complete path ending with a filename
  
  =cut
  
  sub catfile {
      my $self = shift;
      my $file = $self->canonpath(pop @_);
      return $file unless @_;
      my $dir = $self->catdir(@_);
      $dir .= "/" unless substr($dir,-1) eq "/";
      return $dir.$file;
  }
  
  =item curdir
  
  Returns a string representation of the current directory.  "." on UNIX.
  
  =cut
  
  sub curdir { '.' }
  
  =item devnull
  
  Returns a string representation of the null device. "/dev/null" on UNIX.
  
  =cut
  
  sub devnull { '/dev/null' }
  
  =item rootdir
  
  Returns a string representation of the root directory.  "/" on UNIX.
  
  =cut
  
  sub rootdir { '/' }
  
  =item tmpdir
  
  Returns a string representation of the first writable directory from
  the following list or the current directory if none from the list are
  writable:
  
      $ENV{TMPDIR}
      /tmp
  
  If running under taint mode, and if $ENV{TMPDIR}
  is tainted, it is not used.
  
  =cut
  
  my $tmpdir;
  sub _tmpdir {
      return $tmpdir if defined $tmpdir;
      my $self = shift;
      my @dirlist = @_;
      {
  	no strict 'refs';
  	if (${"\cTAINT"}) { # Check for taint mode on perl >= 5.8.0
              require Scalar::Util;
  	    @dirlist = grep { ! Scalar::Util::tainted($_) } @dirlist;
  	}
  	elsif ($] < 5.007) { # No ${^TAINT} before 5.8
  	    @dirlist = grep { eval { eval('1'.substr $_,0,0) } } @dirlist;
  	}
      }
      foreach (@dirlist) {
  	next unless defined && -d && -w _;
  	$tmpdir = $_;
  	last;
      }
      $tmpdir = $self->curdir unless defined $tmpdir;
      $tmpdir = defined $tmpdir && $self->canonpath($tmpdir);
      return $tmpdir;
  }
  
  sub tmpdir {
      return $tmpdir if defined $tmpdir;
      $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR}, "/tmp" );
  }
  
  =item updir
  
  Returns a string representation of the parent directory.  ".." on UNIX.
  
  =cut
  
  sub updir { '..' }
  
  =item no_upwards
  
  Given a list of file names, strip out those that refer to a parent
  directory. (Does not strip symlinks, only '.', '..', and equivalents.)
  
  =cut
  
  sub no_upwards {
      my $self = shift;
      return grep(!/^\.{1,2}\z/s, @_);
  }
  
  =item case_tolerant
  
  Returns a true or false value indicating, respectively, that alphabetic
  is not or is significant when comparing file specifications.
  
  =cut
  
  sub case_tolerant { 0 }
  
  =item file_name_is_absolute
  
  Takes as argument a path and returns true if it is an absolute path.
  
  This does not consult the local filesystem on Unix, Win32, OS/2 or Mac 
  OS (Classic).  It does consult the working environment for VMS (see
  L<File::Spec::VMS/file_name_is_absolute>).
  
  =cut
  
  sub file_name_is_absolute {
      my ($self,$file) = @_;
      return scalar($file =~ m:^/:s);
  }
  
  =item path
  
  Takes no argument, returns the environment variable PATH as an array.
  
  =cut
  
  sub path {
      return () unless exists $ENV{PATH};
      my @path = split(':', $ENV{PATH});
      foreach (@path) { $_ = '.' if $_ eq '' }
      return @path;
  }
  
  =item join
  
  join is the same as catfile.
  
  =cut
  
  sub join {
      my $self = shift;
      return $self->catfile(@_);
  }
  
  =item splitpath
  
      ($volume,$directories,$file) = File::Spec->splitpath( $path );
      ($volume,$directories,$file) = File::Spec->splitpath( $path,
                                                            $no_file );
  
  Splits a path into volume, directory, and filename portions. On systems
  with no concept of volume, returns '' for volume. 
  
  For systems with no syntax differentiating filenames from directories, 
  assumes that the last file is a path unless $no_file is true or a 
  trailing separator or /. or /.. is present. On Unix this means that $no_file
  true makes this return ( '', $path, '' ).
  
  The directory portion may or may not be returned with a trailing '/'.
  
  The results can be passed to L</catpath()> to get back a path equivalent to
  (usually identical to) the original path.
  
  =cut
  
  sub splitpath {
      my ($self,$path, $nofile) = @_;
  
      my ($volume,$directory,$file) = ('','','');
  
      if ( $nofile ) {
          $directory = $path;
      }
      else {
          $path =~ m|^ ( (?: .* / (?: \.\.?\z )? )? ) ([^/]*) |xs;
          $directory = $1;
          $file      = $2;
      }
  
      return ($volume,$directory,$file);
  }
  
  
  =item splitdir
  
  The opposite of L</catdir()>.
  
      @dirs = File::Spec->splitdir( $directories );
  
  $directories must be only the directory portion of the path on systems 
  that have the concept of a volume or that have path syntax that differentiates
  files from directories.
  
  Unlike just splitting the directories on the separator, empty
  directory names (C<''>) can be returned, because these are significant
  on some OSs.
  
  On Unix,
  
      File::Spec->splitdir( "/a/b//c/" );
  
  Yields:
  
      ( '', 'a', 'b', '', 'c', '' )
  
  =cut
  
  sub splitdir {
      return split m|/|, $_[1], -1;  # Preserve trailing fields
  }
  
  
  =item catpath()
  
  Takes volume, directory and file portions and returns an entire path. Under
  Unix, $volume is ignored, and directory and file are concatenated.  A '/' is
  inserted if needed (though if the directory portion doesn't start with
  '/' it is not added).  On other OSs, $volume is significant.
  
  =cut
  
  sub catpath {
      my ($self,$volume,$directory,$file) = @_;
  
      if ( $directory ne ''                && 
           $file ne ''                     && 
           substr( $directory, -1 ) ne '/' && 
           substr( $file, 0, 1 ) ne '/' 
      ) {
          $directory .= "/$file" ;
      }
      else {
          $directory .= $file ;
      }
  
      return $directory ;
  }
  
  =item abs2rel
  
  Takes a destination path and an optional base path returns a relative path
  from the base path to the destination path:
  
      $rel_path = File::Spec->abs2rel( $path ) ;
      $rel_path = File::Spec->abs2rel( $path, $base ) ;
  
  If $base is not present or '', then L<cwd()|Cwd> is used. If $base is
  relative, then it is converted to absolute form using
  L</rel2abs()>. This means that it is taken to be relative to
  L<cwd()|Cwd>.
  
  On systems that have a grammar that indicates filenames, this ignores the 
  $base filename. Otherwise all path components are assumed to be
  directories.
  
  If $path is relative, it is converted to absolute form using L</rel2abs()>.
  This means that it is taken to be relative to L<cwd()|Cwd>.
  
  No checks against the filesystem are made, so the result may not be correct if
  C<$base> contains symbolic links.  (Apply
  L<Cwd::abs_path()|Cwd/abs_path> beforehand if that
  is a concern.)  On VMS, there is interaction with the working environment, as
  logicals and macros are expanded.
  
  Based on code written by Shigio Yamaguchi.
  
  =cut
  
  sub abs2rel {
      my($self,$path,$base) = @_;
      $base = $self->_cwd() unless defined $base and length $base;
  
      ($path, $base) = map $self->canonpath($_), $path, $base;
  
      my $path_directories;
      my $base_directories;
  
      if (grep $self->file_name_is_absolute($_), $path, $base) {
  	($path, $base) = map $self->rel2abs($_), $path, $base;
  
      my ($path_volume) = $self->splitpath($path, 1);
      my ($base_volume) = $self->splitpath($base, 1);
  
      # Can't relativize across volumes
      return $path unless $path_volume eq $base_volume;
  
  	$path_directories = ($self->splitpath($path, 1))[1];
  	$base_directories = ($self->splitpath($base, 1))[1];
  
      # For UNC paths, the user might give a volume like //foo/bar that
      # strictly speaking has no directory portion.  Treat it as if it
      # had the root directory for that volume.
      if (!length($base_directories) and $self->file_name_is_absolute($base)) {
        $base_directories = $self->rootdir;
      }
      }
      else {
  	my $wd= ($self->splitpath($self->_cwd(), 1))[1];
  	$path_directories = $self->catdir($wd, $path);
  	$base_directories = $self->catdir($wd, $base);
      }
  
      # Now, remove all leading components that are the same
      my @pathchunks = $self->splitdir( $path_directories );
      my @basechunks = $self->splitdir( $base_directories );
  
      if ($base_directories eq $self->rootdir) {
        return $self->curdir if $path_directories eq $self->rootdir;
        shift @pathchunks;
        return $self->canonpath( $self->catpath('', $self->catdir( @pathchunks ), '') );
      }
  
      my @common;
      while (@pathchunks && @basechunks && $self->_same($pathchunks[0], $basechunks[0])) {
          push @common, shift @pathchunks ;
          shift @basechunks ;
      }
      return $self->curdir unless @pathchunks || @basechunks;
  
      # @basechunks now contains the directories the resulting relative path 
      # must ascend out of before it can descend to $path_directory.  If there
      # are updir components, we must descend into the corresponding directories
      # (this only works if they are no symlinks).
      my @reverse_base;
      while( defined(my $dir= shift @basechunks) ) {
  	if( $dir ne $self->updir ) {
  	    unshift @reverse_base, $self->updir;
  	    push @common, $dir;
  	}
  	elsif( @common ) {
  	    if( @reverse_base && $reverse_base[0] eq $self->updir ) {
  		shift @reverse_base;
  		pop @common;
  	    }
  	    else {
  		unshift @reverse_base, pop @common;
  	    }
  	}
      }
      my $result_dirs = $self->catdir( @reverse_base, @pathchunks );
      return $self->canonpath( $self->catpath('', $result_dirs, '') );
  }
  
  sub _same {
    $_[1] eq $_[2];
  }
  
  =item rel2abs()
  
  Converts a relative path to an absolute path. 
  
      $abs_path = File::Spec->rel2abs( $path ) ;
      $abs_path = File::Spec->rel2abs( $path, $base ) ;
  
  If $base is not present or '', then L<cwd()|Cwd> is used. If $base is
  relative, then it is converted to absolute form using
  L</rel2abs()>. This means that it is taken to be relative to
  L<cwd()|Cwd>.
  
  On systems that have a grammar that indicates filenames, this ignores
  the $base filename. Otherwise all path components are assumed to be
  directories.
  
  If $path is absolute, it is cleaned up and returned using L</canonpath()>.
  
  No checks against the filesystem are made.  On VMS, there is
  interaction with the working environment, as logicals and
  macros are expanded.
  
  Based on code written by Shigio Yamaguchi.
  
  =cut
  
  sub rel2abs {
      my ($self,$path,$base ) = @_;
  
      # Clean up $path
      if ( ! $self->file_name_is_absolute( $path ) ) {
          # Figure out the effective $base and clean it up.
          if ( !defined( $base ) || $base eq '' ) {
  	    $base = $self->_cwd();
          }
          elsif ( ! $self->file_name_is_absolute( $base ) ) {
              $base = $self->rel2abs( $base ) ;
          }
          else {
              $base = $self->canonpath( $base ) ;
          }
  
          # Glom them together
          $path = $self->catdir( $base, $path ) ;
      }
  
      return $self->canonpath( $path ) ;
  }
  
  =back
  
  =head1 COPYRIGHT
  
  Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
  
  This program is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself.
  
  Please submit bug reports and patches to perlbug@perl.org.
  
  =head1 SEE ALSO
  
  L<File::Spec>
  
  =cut
  
  # Internal routine to File::Spec, no point in making this public since
  # it is the standard Cwd interface.  Most of the platform-specific
  # File::Spec subclasses use this.
  sub _cwd {
      require Cwd;
      Cwd::getcwd();
  }
  
  
  # Internal method to reduce xx\..\yy -> yy
  sub _collapse {
      my($fs, $path) = @_;
  
      my $updir  = $fs->updir;
      my $curdir = $fs->curdir;
  
      my($vol, $dirs, $file) = $fs->splitpath($path);
      my @dirs = $fs->splitdir($dirs);
      pop @dirs if @dirs && $dirs[-1] eq '';
  
      my @collapsed;
      foreach my $dir (@dirs) {
          if( $dir eq $updir              and   # if we have an updir
              @collapsed                  and   # and something to collapse
              length $collapsed[-1]       and   # and its not the rootdir
              $collapsed[-1] ne $updir    and   # nor another updir
              $collapsed[-1] ne $curdir         # nor the curdir
            ) 
          {                                     # then
              pop @collapsed;                   # collapse
          }
          else {                                # else
              push @collapsed, $dir;            # just hang onto it
          }
      }
  
      return $fs->catpath($vol,
                          $fs->catdir(@collapsed),
                          $file
                         );
  }
  
  
  1;
X86_64-LINUX_FILE_SPEC_UNIX

$fatpacked{"x86_64-linux/File/Spec/VMS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'X86_64-LINUX_FILE_SPEC_VMS';
  package File::Spec::VMS;
  
  use strict;
  use vars qw(@ISA $VERSION);
  require File::Spec::Unix;
  
  $VERSION = '3.40';
  $VERSION =~ tr/_//;
  
  @ISA = qw(File::Spec::Unix);
  
  use File::Basename;
  use VMS::Filespec;
  
  =head1 NAME
  
  File::Spec::VMS - methods for VMS file specs
  
  =head1 SYNOPSIS
  
   require File::Spec::VMS; # Done internally by File::Spec if needed
  
  =head1 DESCRIPTION
  
  See File::Spec::Unix for a documentation of the methods provided
  there. This package overrides the implementation of these methods, not
  the semantics.
  
  The default behavior is to allow either VMS or Unix syntax on input and to 
  return VMS syntax on output unless Unix syntax has been explicity requested
  via the C<DECC$FILENAME_UNIX_REPORT> CRTL feature.
  
  =over 4
  
  =cut
  
  # Need to look up the feature settings.  The preferred way is to use the
  # VMS::Feature module, but that may not be available to dual life modules.
  
  my $use_feature;
  BEGIN {
      if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
          $use_feature = 1;
      }
  }
  
  # Need to look up the UNIX report mode.  This may become a dynamic mode
  # in the future.
  sub _unix_rpt {
      my $unix_rpt;
      if ($use_feature) {
          $unix_rpt = VMS::Feature::current("filename_unix_report");
      } else {
          my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
          $unix_rpt = $env_unix_rpt =~ /^[ET1]/i; 
      }
      return $unix_rpt;
  }
  
  =item canonpath (override)
  
  Removes redundant portions of file specifications and returns results
  in native syntax unless Unix filename reporting has been enabled.
  
  =cut
  
  
  sub canonpath {
      my($self,$path) = @_;
  
      return undef unless defined $path;
  
      my $unix_rpt = $self->_unix_rpt;
  
      if ($path =~ m|/|) {
        my $pathify = $path =~ m|/\Z(?!\n)|;
        $path = $self->SUPER::canonpath($path);
  
        return $path if $unix_rpt;
        $path = $pathify ? vmspath($path) : vmsify($path);
      }
  
      $path =~ s/(?<!\^)</[/;			# < and >       ==> [ and ]
      $path =~ s/(?<!\^)>/]/;
      $path =~ s/(?<!\^)\]\[\./\.\]\[/g;		# ][.		==> .][
      $path =~ s/(?<!\^)\[000000\.\]\[/\[/g;	# [000000.][	==> [
      $path =~ s/(?<!\^)\[000000\./\[/g;		# [000000.	==> [
      $path =~ s/(?<!\^)\.\]\[000000\]/\]/g;	# .][000000]	==> ]
      $path =~ s/(?<!\^)\.\]\[/\./g;		# foo.][bar     ==> foo.bar
      1 while ($path =~ s/(?<!\^)([\[\.])(-+)\.(-+)([\.\]])/$1$2$3$4/);
  						# That loop does the following
  						# with any amount of dashes:
  						# .-.-.		==> .--.
  						# [-.-.		==> [--.
  						# .-.-]		==> .--]
  						# [-.-]		==> [--]
      1 while ($path =~ s/(?<!\^)([\[\.])[^\]\.]+\.-(-+)([\]\.])/$1$2$3/);
  						# That loop does the following
  						# with any amount (minimum 2)
  						# of dashes:
  						# .foo.--.	==> .-.
  						# .foo.--]	==> .-]
  						# [foo.--.	==> [-.
  						# [foo.--]	==> [-]
  						#
  						# And then, the remaining cases
      $path =~ s/(?<!\^)\[\.-/[-/;		# [.-		==> [-
      $path =~ s/(?<!\^)\.[^\]\.]+\.-\./\./g;	# .foo.-.	==> .
      $path =~ s/(?<!\^)\[[^\]\.]+\.-\./\[/g;	# [foo.-.	==> [
      $path =~ s/(?<!\^)\.[^\]\.]+\.-\]/\]/g;	# .foo.-]	==> ]
  						# [foo.-]       ==> [000000]
      $path =~ s/(?<!\^)\[[^\]\.]+\.-\]/\[000000\]/g;
  						# []		==>
      $path =~ s/(?<!\^)\[\]// unless $path eq '[]';
      return $unix_rpt ? unixify($path) : $path;
  }
  
  =item catdir (override)
  
  Concatenates a list of file specifications, and returns the result as a
  native directory specification unless the Unix filename reporting feature
  has been enabled.  No check is made for "impossible" cases (e.g. elements
  other than the first being absolute filespecs).
  
  =cut
  
  sub catdir {
      my $self = shift;
      my $dir = pop;
  
      my $unix_rpt = $self->_unix_rpt;
  
      my @dirs = grep {defined() && length()} @_;
  
      my $rslt;
      if (@dirs) {
  	my $path = (@dirs == 1 ? $dirs[0] : $self->catdir(@dirs));
  	my ($spath,$sdir) = ($path,$dir);
  	$spath =~ s/\.dir\Z(?!\n)//i; $sdir =~ s/\.dir\Z(?!\n)//i; 
  
  	if ($unix_rpt) {
  	    $spath = unixify($spath) unless $spath =~ m#/#;
  	    $sdir= unixify($sdir) unless $sdir =~ m#/#;
              return $self->SUPER::catdir($spath, $sdir)
              }
  
  	$sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+\Z(?!\n)/s;
  	    $rslt = $self->fixpath($self->eliminate_macros($spath)."/$sdir",1);
  
  	    # Special case for VMS absolute directory specs: these will have
  	    # had device prepended during trip through Unix syntax in
  	    # eliminate_macros(), since Unix syntax has no way to express
  	    # "absolute from the top of this device's directory tree".
  	    if ($spath =~ /^[\[<][^.\-]/s) { $rslt =~ s/^[^\[<]+//s; }
  
                  } else {
  	# Single directory. Return an empty string on null input; otherwise
  	# just return a canonical path.
  
  	if    (not defined $dir or not length $dir) {
  	    $rslt = '';
              } else {
  	    $rslt = $unix_rpt ? $dir : vmspath($dir);
  	}
      }
      return $self->canonpath($rslt);
  }
  
  =item catfile (override)
  
  Concatenates a list of directory specifications with a filename specification
  to build a path.
  
  =cut
  
  sub catfile {
      my $self = shift;
      my $tfile = pop();
      my $file = $self->canonpath($tfile);
      my @files = grep {defined() && length()} @_;
  
      my $unix_rpt = $self->_unix_rpt;
  
      my $rslt;
      if (@files) {
  	my $path = (@files == 1 ? $files[0] : $self->catdir(@files));
  	my $spath = $path;
  
          # Something building a VMS path in pieces may try to pass a
          # directory name in filename format, so normalize it.
  	$spath =~ s/\.dir\Z(?!\n)//i;
  
          # If the spath ends with a directory delimiter and the file is bare,
          # then just concatenate them.
  	if ($spath =~ /^(?<!\^)[^\)\]\/:>]+\)\Z(?!\n)/s && basename($file) eq $file) {
  	    $rslt = "$spath$file";
  	} else {
  		$rslt = $self->eliminate_macros($spath);
             $rslt .= (defined($rslt) && length($rslt) ? '/' : '') . unixify($file);
             $rslt = vmsify($rslt) unless $unix_rpt;
  	}
      }
      else {
          # Only passed a single file?
          my $xfile = (defined($file) && length($file)) ? $file : '';
  
          $rslt = $unix_rpt ? $file : vmsify($file);
      }
      return $self->canonpath($rslt) unless $unix_rpt;
  
      # In Unix report mode, do not strip off redundant path information.
      return $rslt;
  }
  
  
  =item curdir (override)
  
  Returns a string representation of the current directory: '[]' or '.'
  
  =cut
  
  sub curdir {
      my $self = shift @_;
      return '.' if ($self->_unix_rpt);
      return '[]';
  }
  
  =item devnull (override)
  
  Returns a string representation of the null device: '_NLA0:' or '/dev/null'
  
  =cut
  
  sub devnull {
      my $self = shift @_;
      return '/dev/null' if ($self->_unix_rpt);
      return "_NLA0:";
  }
  
  =item rootdir (override)
  
  Returns a string representation of the root directory: 'SYS$DISK:[000000]'
  or '/'
  
  =cut
  
  sub rootdir {
      my $self = shift @_;
      if ($self->_unix_rpt) {
         # Root may exist, try it first.
         my $try = '/';
         my ($dev1, $ino1) = stat('/');
         my ($dev2, $ino2) = stat('.');
  
         # Perl falls back to '.' if it can not determine '/'
         if (($dev1 != $dev2) || ($ino1 != $ino2)) {
             return $try;
         }
         # Fall back to UNIX format sys$disk.
         return '/sys$disk/';
      }
      return 'SYS$DISK:[000000]';
  }
  
  =item tmpdir (override)
  
  Returns a string representation of the first writable directory
  from the following list or '' if none are writable:
  
      /tmp if C<DECC$FILENAME_UNIX_REPORT> is enabled.
      sys$scratch:
      $ENV{TMPDIR}
  
  Since perl 5.8.0, if running under taint mode, and if $ENV{TMPDIR}
  is tainted, it is not used.
  
  =cut
  
  my $tmpdir;
  sub tmpdir {
      my $self = shift @_;
      return $tmpdir if defined $tmpdir;
      if ($self->_unix_rpt) {
          $tmpdir = $self->_tmpdir('/tmp', '/sys$scratch', $ENV{TMPDIR});
          return $tmpdir;
      }
  
      $tmpdir = $self->_tmpdir( 'sys$scratch:', $ENV{TMPDIR} );
  }
  
  =item updir (override)
  
  Returns a string representation of the parent directory: '[-]' or '..'
  
  =cut
  
  sub updir {
      my $self = shift @_;
      return '..' if ($self->_unix_rpt);
      return '[-]';
  }
  
  =item case_tolerant (override)
  
  VMS file specification syntax is case-tolerant.
  
  =cut
  
  sub case_tolerant {
      return 1;
  }
  
  =item path (override)
  
  Translate logical name DCL$PATH as a searchlist, rather than trying
  to C<split> string value of C<$ENV{'PATH'}>.
  
  =cut
  
  sub path {
      my (@dirs,$dir,$i);
      while ($dir = $ENV{'DCL$PATH;' . $i++}) { push(@dirs,$dir); }
      return @dirs;
  }
  
  =item file_name_is_absolute (override)
  
  Checks for VMS directory spec as well as Unix separators.
  
  =cut
  
  sub file_name_is_absolute {
      my ($self,$file) = @_;
      # If it's a logical name, expand it.
      $file = $ENV{$file} while $file =~ /^[\w\$\-]+\Z(?!\n)/s && $ENV{$file};
      return scalar($file =~ m!^/!s             ||
  		  $file =~ m![<\[][^.\-\]>]!  ||
  		  $file =~ /:[^<\[]/);
  }
  
  =item splitpath (override)
  
      ($volume,$directories,$file) = File::Spec->splitpath( $path );
      ($volume,$directories,$file) = File::Spec->splitpath( $path,
                                                            $no_file );
  
  Passing a true value for C<$no_file> indicates that the path being
  split only contains directory components, even on systems where you
  can usually (when not supporting a foreign syntax) tell the difference
  between directories and files at a glance.
  
  =cut
  
  sub splitpath {
      my($self,$path, $nofile) = @_;
      my($dev,$dir,$file)      = ('','','');
      my $vmsify_path = vmsify($path);
  
      if ( $nofile ) {
          #vmsify('d1/d2/d3') returns '[.d1.d2]d3'
          #vmsify('/d1/d2/d3') returns 'd1:[d2]d3'
          if( $vmsify_path =~ /(.*)\](.+)/ ){
              $vmsify_path = $1.'.'.$2.']';
          }
          $vmsify_path =~ /(.+:)?(.*)/s;
          $dir = defined $2 ? $2 : ''; # dir can be '0'
          return ($1 || '',$dir,$file);
      }
      else {
          $vmsify_path =~ /(.+:)?([\[<].*[\]>])?(.*)/s;
          return ($1 || '',$2 || '',$3);
      }
  }
  
  =item splitdir (override)
  
  Split a directory specification into the components.
  
  =cut
  
  sub splitdir {
      my($self,$dirspec) = @_;
      my @dirs = ();
      return @dirs if ( (!defined $dirspec) || ('' eq $dirspec) );
  
      $dirspec =~ s/(?<!\^)</[/;                  # < and >	==> [ and ]
      $dirspec =~ s/(?<!\^)>/]/;
      $dirspec =~ s/(?<!\^)\]\[\./\.\]\[/g;	# ][.		==> .][
      $dirspec =~ s/(?<!\^)\[000000\.\]\[/\[/g;	# [000000.][	==> [
      $dirspec =~ s/(?<!\^)\[000000\./\[/g;	# [000000.	==> [
      $dirspec =~ s/(?<!\^)\.\]\[000000\]/\]/g;	# .][000000]	==> ]
      $dirspec =~ s/(?<!\^)\.\]\[/\./g;		# foo.][bar	==> foo.bar
      while ($dirspec =~ s/(^|[\[\<\.])\-(\-+)($|[\]\>\.])/$1-.$2$3/g) {}
  						# That loop does the following
  						# with any amount of dashes:
  						# .--.		==> .-.-.
  						# [--.		==> [-.-.
  						# .--]		==> .-.-]
  						# [--]		==> [-.-]
      $dirspec = "[$dirspec]" unless $dirspec =~ /(?<!\^)[\[<]/; # make legal
      $dirspec =~ s/^(\[|<)\./$1/;
      @dirs = split /(?<!\^)\./, vmspath($dirspec);
      $dirs[0] =~ s/^[\[<]//s;  $dirs[-1] =~ s/[\]>]\Z(?!\n)//s;
      @dirs;
  }
  
  
  =item catpath (override)
  
  Construct a complete filespec.
  
  =cut
  
  sub catpath {
      my($self,$dev,$dir,$file) = @_;
      
      # We look for a volume in $dev, then in $dir, but not both
          my ($dir_volume, $dir_dir, $dir_file) = $self->splitpath($dir);
          $dev = $dir_volume unless length $dev;
      $dir = length $dir_file ? $self->catfile($dir_dir, $dir_file) : $dir_dir;
      
      if ($dev =~ m|^(?<!\^)/+([^/]+)|) { $dev = "$1:"; }
      else { $dev .= ':' unless $dev eq '' or $dev =~ /:\Z(?!\n)/; }
      if (length($dev) or length($dir)) {
          $dir = "[$dir]" unless $dir =~ /(?<!\^)[\[<\/]/;
            $dir = vmspath($dir);
        }
      $dir = '' if length($dev) && ($dir eq '[]' || $dir eq '<>');
      "$dev$dir$file";
  }
  
  =item abs2rel (override)
  
  Attempt to convert an absolute file specification to a relative specification.
  
  =cut
  
  sub abs2rel {
      my $self = shift;
      return vmspath(File::Spec::Unix::abs2rel( $self, @_ ))
          if grep m{/}, @_;
  
      my($path,$base) = @_;
      $base = $self->_cwd() unless defined $base and length $base;
  
      for ($path, $base) { $_ = $self->canonpath($_) }
  
      # Are we even starting $path on the same (node::)device as $base?  Note that
      # logical paths or nodename differences may be on the "same device" 
      # but the comparison that ignores device differences so as to concatenate 
      # [---] up directory specs is not even a good idea in cases where there is 
      # a logical path difference between $path and $base nodename and/or device.
      # Hence we fall back to returning the absolute $path spec
      # if there is a case blind device (or node) difference of any sort
      # and we do not even try to call $parse() or consult %ENV for $trnlnm()
      # (this module needs to run on non VMS platforms after all).
      
      my ($path_volume, $path_directories, $path_file) = $self->splitpath($path);
      my ($base_volume, $base_directories, $base_file) = $self->splitpath($base);
      return $path unless lc($path_volume) eq lc($base_volume);
  
      for ($path, $base) { $_ = $self->rel2abs($_) }
  
      # Now, remove all leading components that are the same
      my @pathchunks = $self->splitdir( $path_directories );
      my $pathchunks = @pathchunks;
      unshift(@pathchunks,'000000') unless $pathchunks[0] eq '000000';
      my @basechunks = $self->splitdir( $base_directories );
      my $basechunks = @basechunks;
      unshift(@basechunks,'000000') unless $basechunks[0] eq '000000';
  
      while ( @pathchunks && 
              @basechunks && 
              lc( $pathchunks[0] ) eq lc( $basechunks[0] ) 
            ) {
          shift @pathchunks ;
          shift @basechunks ;
      }
  
      # @basechunks now contains the directories to climb out of,
      # @pathchunks now has the directories to descend in to.
      if ((@basechunks > 0) || ($basechunks != $pathchunks)) {
        $path_directories = join '.', ('-' x @basechunks, @pathchunks) ;
      }
      else {
        $path_directories = join '.', @pathchunks;
      }
      $path_directories = '['.$path_directories.']';
      return $self->canonpath( $self->catpath( '', $path_directories, $path_file ) ) ;
  }
  
  
  =item rel2abs (override)
  
  Return an absolute file specification from a relative one.
  
  =cut
  
  sub rel2abs {
      my $self = shift ;
      my ($path,$base ) = @_;
      return undef unless defined $path;
          if ($path =~ m/\//) {
  	    $path = ( -d $path || $path =~ m/\/\z/  # educated guessing about
  		       ? vmspath($path)             # whether it's a directory
  		       : vmsify($path) );
          }
      $base = vmspath($base) if defined $base && $base =~ m/\//;
  
      # Clean up and split up $path
      if ( ! $self->file_name_is_absolute( $path ) ) {
          # Figure out the effective $base and clean it up.
          if ( !defined( $base ) || $base eq '' ) {
              $base = $self->_cwd;
          }
          elsif ( ! $self->file_name_is_absolute( $base ) ) {
              $base = $self->rel2abs( $base ) ;
          }
          else {
              $base = $self->canonpath( $base ) ;
          }
  
          # Split up paths
          my ( $path_directories, $path_file ) =
              ($self->splitpath( $path ))[1,2] ;
  
          my ( $base_volume, $base_directories ) =
              $self->splitpath( $base ) ;
  
          $path_directories = '' if $path_directories eq '[]' ||
                                    $path_directories eq '<>';
          my $sep = '' ;
              $sep = '.'
                  if ( $base_directories =~ m{[^.\]>]\Z(?!\n)} &&
                       $path_directories =~ m{^[^.\[<]}s
                  ) ;
              $base_directories = "$base_directories$sep$path_directories";
              $base_directories =~ s{\.?[\]>][\[<]\.?}{.};
  
          $path = $self->catpath( $base_volume, $base_directories, $path_file );
     }
  
      return $self->canonpath( $path ) ;
  }
  
  
  # eliminate_macros() and fixpath() are MakeMaker-specific methods
  # which are used inside catfile() and catdir().  MakeMaker has its own
  # copies as of 6.06_03 which are the canonical ones.  We leave these
  # here, in peace, so that File::Spec continues to work with MakeMakers
  # prior to 6.06_03.
  # 
  # Please consider these two methods deprecated.  Do not patch them,
  # patch the ones in ExtUtils::MM_VMS instead.
  #
  # Update:  MakeMaker 6.48 is still using these routines on VMS.
  # so they need to be kept up to date with ExtUtils::MM_VMS.
  
  sub eliminate_macros {
      my($self,$path) = @_;
      return '' unless (defined $path) && ($path ne '');
      $self = {} unless ref $self;
  
      if ($path =~ /\s/) {
        return join ' ', map { $self->eliminate_macros($_) } split /\s+/, $path;
      }
  
      my $npath = unixify($path);
      # sometimes unixify will return a string with an off-by-one trailing null
      $npath =~ s{\0$}{};
  
      my($complex) = 0;
      my($head,$macro,$tail);
  
      # perform m##g in scalar context so it acts as an iterator
      while ($npath =~ m#(.*?)\$\((\S+?)\)(.*)#gs) { 
          if (defined $self->{$2}) {
              ($head,$macro,$tail) = ($1,$2,$3);
              if (ref $self->{$macro}) {
                  if (ref $self->{$macro} eq 'ARRAY') {
                      $macro = join ' ', @{$self->{$macro}};
                  }
                  else {
                      print "Note: can't expand macro \$($macro) containing ",ref($self->{$macro}),
                            "\n\t(using MMK-specific deferred substitutuon; MMS will break)\n";
                      $macro = "\cB$macro\cB";
                      $complex = 1;
                  }
              }
              else { ($macro = unixify($self->{$macro})) =~ s#/\Z(?!\n)##; }
              $npath = "$head$macro$tail";
          }
      }
      if ($complex) { $npath =~ s#\cB(.*?)\cB#\${$1}#gs; }
      $npath;
  }
  
  # Deprecated.  See the note above for eliminate_macros().
  
  # Catchall routine to clean up problem MM[SK]/Make macros.  Expands macros
  # in any directory specification, in order to avoid juxtaposing two
  # VMS-syntax directories when MM[SK] is run.  Also expands expressions which
  # are all macro, so that we can tell how long the expansion is, and avoid
  # overrunning DCL's command buffer when MM[KS] is running.
  
  # fixpath() checks to see whether the result matches the name of a
  # directory in the current default directory and returns a directory or
  # file specification accordingly.  C<$is_dir> can be set to true to
  # force fixpath() to consider the path to be a directory or false to force
  # it to be a file.
  
  sub fixpath {
      my($self,$path,$force_path) = @_;
      return '' unless $path;
      $self = bless {}, $self unless ref $self;
      my($fixedpath,$prefix,$name);
  
      if ($path =~ /\s/) {
        return join ' ',
               map { $self->fixpath($_,$force_path) }
  	     split /\s+/, $path;
      }
  
      if ($path =~ m#^\$\([^\)]+\)\Z(?!\n)#s || $path =~ m#[/:>\]]#) { 
          if ($force_path or $path =~ /(?:DIR\)|\])\Z(?!\n)/) {
              $fixedpath = vmspath($self->eliminate_macros($path));
          }
          else {
              $fixedpath = vmsify($self->eliminate_macros($path));
          }
      }
      elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#s)) && $self->{$prefix}) {
          my($vmspre) = $self->eliminate_macros("\$($prefix)");
          # is it a dir or just a name?
          $vmspre = ($vmspre =~ m|/| or $prefix =~ /DIR\Z(?!\n)/) ? vmspath($vmspre) : '';
          $fixedpath = ($vmspre ? $vmspre : $self->{$prefix}) . $name;
          $fixedpath = vmspath($fixedpath) if $force_path;
      }
      else {
          $fixedpath = $path;
          $fixedpath = vmspath($fixedpath) if $force_path;
      }
      # No hints, so we try to guess
      if (!defined($force_path) and $fixedpath !~ /[:>(.\]]/) {
          $fixedpath = vmspath($fixedpath) if -d $fixedpath;
      }
  
      # Trim off root dirname if it's had other dirs inserted in front of it.
      $fixedpath =~ s/\.000000([\]>])/$1/;
      # Special case for VMS absolute directory specs: these will have had device
      # prepended during trip through Unix syntax in eliminate_macros(), since
      # Unix syntax has no way to express "absolute from the top of this device's
      # directory tree".
      if ($path =~ /^[\[>][^.\-]/) { $fixedpath =~ s/^[^\[<]+//; }
      $fixedpath;
  }
  
  
  =back
  
  =head1 COPYRIGHT
  
  Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
  
  This program is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself.
  
  =head1 SEE ALSO
  
  See L<File::Spec> and L<File::Spec::Unix>.  This package overrides the
  implementation of these methods, not the semantics.
  
  An explanation of VMS file specs can be found at
  L<http://h71000.www7.hp.com/doc/731FINAL/4506/4506pro_014.html#apps_locating_naming_files>.
  
  =cut
  
  1;
X86_64-LINUX_FILE_SPEC_VMS

$fatpacked{"x86_64-linux/File/Spec/Win32.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'X86_64-LINUX_FILE_SPEC_WIN32';
  package File::Spec::Win32;
  
  use strict;
  
  use vars qw(@ISA $VERSION);
  require File::Spec::Unix;
  
  $VERSION = '3.40';
  $VERSION =~ tr/_//;
  
  @ISA = qw(File::Spec::Unix);
  
  # Some regexes we use for path splitting
  my $DRIVE_RX = '[a-zA-Z]:';
  my $UNC_RX = '(?:\\\\\\\\|//)[^\\\\/]+[\\\\/][^\\\\/]+';
  my $VOL_RX = "(?:$DRIVE_RX|$UNC_RX)";
  
  
  =head1 NAME
  
  File::Spec::Win32 - methods for Win32 file specs
  
  =head1 SYNOPSIS
  
   require File::Spec::Win32; # Done internally by File::Spec if needed
  
  =head1 DESCRIPTION
  
  See File::Spec::Unix for a documentation of the methods provided
  there. This package overrides the implementation of these methods, not
  the semantics.
  
  =over 4
  
  =item devnull
  
  Returns a string representation of the null device.
  
  =cut
  
  sub devnull {
      return "nul";
  }
  
  sub rootdir { '\\' }
  
  
  =item tmpdir
  
  Returns a string representation of the first existing directory
  from the following list:
  
      $ENV{TMPDIR}
      $ENV{TEMP}
      $ENV{TMP}
      SYS:/temp
      C:\system\temp
      C:/temp
      /tmp
      /
  
  The SYS:/temp is preferred in Novell NetWare and the C:\system\temp
  for Symbian (the File::Spec::Win32 is used also for those platforms).
  
  Since Perl 5.8.0, if running under taint mode, and if the environment
  variables are tainted, they are not used.
  
  =cut
  
  my $tmpdir;
  sub tmpdir {
      return $tmpdir if defined $tmpdir;
      $tmpdir = $_[0]->_tmpdir( map( $ENV{$_}, qw(TMPDIR TEMP TMP) ),
  			      'SYS:/temp',
  			      'C:\system\temp',
  			      'C:/temp',
  			      '/tmp',
  			      '/'  );
  }
  
  =item case_tolerant
  
  MSWin32 case-tolerance depends on GetVolumeInformation() $ouFsFlags == FS_CASE_SENSITIVE,
  indicating the case significance when comparing file specifications.
  Since XP FS_CASE_SENSITIVE is effectively disabled for the NT subsubsystem.
  See http://cygwin.com/ml/cygwin/2007-07/msg00891.html
  Default: 1
  
  =cut
  
  sub case_tolerant {
    eval { require Win32API::File; } or return 1;
    my $drive = shift || "C:";
    my $osFsType = "\0"x256;
    my $osVolName = "\0"x256;
    my $ouFsFlags = 0;
    Win32API::File::GetVolumeInformation($drive, $osVolName, 256, [], [], $ouFsFlags, $osFsType, 256 );
    if ($ouFsFlags & Win32API::File::FS_CASE_SENSITIVE()) { return 0; }
    else { return 1; }
  }
  
  =item file_name_is_absolute
  
  As of right now, this returns 2 if the path is absolute with a
  volume, 1 if it's absolute with no volume, 0 otherwise.
  
  =cut
  
  sub file_name_is_absolute {
  
      my ($self,$file) = @_;
  
      if ($file =~ m{^($VOL_RX)}o) {
        my $vol = $1;
        return ($vol =~ m{^$UNC_RX}o ? 2
  	      : $file =~ m{^$DRIVE_RX[\\/]}o ? 2
  	      : 0);
      }
      return $file =~  m{^[\\/]} ? 1 : 0;
  }
  
  =item catfile
  
  Concatenate one or more directory names and a filename to form a
  complete path ending with a filename
  
  =cut
  
  sub catfile {
      shift;
  
      # Legacy / compatibility support
      #
      shift, return _canon_cat( "/", @_ )
  	if $_[0] eq "";
  
      # Compatibility with File::Spec <= 3.26:
      #     catfile('A:', 'foo') should return 'A:\foo'.
      return _canon_cat( ($_[0].'\\'), @_[1..$#_] )
          if $_[0] =~ m{^$DRIVE_RX\z}o;
  
      return _canon_cat( @_ );
  }
  
  sub catdir {
      shift;
  
      # Legacy / compatibility support
      #
      return ""
      	unless @_;
      shift, return _canon_cat( "/", @_ )
  	if $_[0] eq "";
  
      # Compatibility with File::Spec <= 3.26:
      #     catdir('A:', 'foo') should return 'A:\foo'.
      return _canon_cat( ($_[0].'\\'), @_[1..$#_] )
          if $_[0] =~ m{^$DRIVE_RX\z}o;
  
      return _canon_cat( @_ );
  }
  
  sub path {
      my @path = split(';', $ENV{PATH});
      s/"//g for @path;
      @path = grep length, @path;
      unshift(@path, ".");
      return @path;
  }
  
  =item canonpath
  
  No physical check on the filesystem, but a logical cleanup of a
  path. On UNIX eliminated successive slashes and successive "/.".
  On Win32 makes 
  
  	dir1\dir2\dir3\..\..\dir4 -> \dir\dir4 and even
  	dir1\dir2\dir3\...\dir4   -> \dir\dir4
  
  =cut
  
  sub canonpath {
      # Legacy / compatibility support
      #
      return $_[1] if !defined($_[1]) or $_[1] eq '';
      return _canon_cat( $_[1] );
  }
  
  =item splitpath
  
      ($volume,$directories,$file) = File::Spec->splitpath( $path );
      ($volume,$directories,$file) = File::Spec->splitpath( $path,
                                                            $no_file );
  
  Splits a path into volume, directory, and filename portions. Assumes that 
  the last file is a path unless the path ends in '\\', '\\.', '\\..'
  or $no_file is true.  On Win32 this means that $no_file true makes this return 
  ( $volume, $path, '' ).
  
  Separators accepted are \ and /.
  
  Volumes can be drive letters or UNC sharenames (\\server\share).
  
  The results can be passed to L</catpath> to get back a path equivalent to
  (usually identical to) the original path.
  
  =cut
  
  sub splitpath {
      my ($self,$path, $nofile) = @_;
      my ($volume,$directory,$file) = ('','','');
      if ( $nofile ) {
          $path =~ 
              m{^ ( $VOL_RX ? ) (.*) }sox;
          $volume    = $1;
          $directory = $2;
      }
      else {
          $path =~ 
              m{^ ( $VOL_RX ? )
                  ( (?:.*[\\/](?:\.\.?\Z(?!\n))?)? )
                  (.*)
               }sox;
          $volume    = $1;
          $directory = $2;
          $file      = $3;
      }
  
      return ($volume,$directory,$file);
  }
  
  
  =item splitdir
  
  The opposite of L<catdir()|File::Spec/catdir>.
  
      @dirs = File::Spec->splitdir( $directories );
  
  $directories must be only the directory portion of the path on systems 
  that have the concept of a volume or that have path syntax that differentiates
  files from directories.
  
  Unlike just splitting the directories on the separator, leading empty and 
  trailing directory entries can be returned, because these are significant
  on some OSs. So,
  
      File::Spec->splitdir( "/a/b/c" );
  
  Yields:
  
      ( '', 'a', 'b', '', 'c', '' )
  
  =cut
  
  sub splitdir {
      my ($self,$directories) = @_ ;
      #
      # split() likes to forget about trailing null fields, so here we
      # check to be sure that there will not be any before handling the
      # simple case.
      #
      if ( $directories !~ m|[\\/]\Z(?!\n)| ) {
          return split( m|[\\/]|, $directories );
      }
      else {
          #
          # since there was a trailing separator, add a file name to the end, 
          # then do the split, then replace it with ''.
          #
          my( @directories )= split( m|[\\/]|, "${directories}dummy" ) ;
          $directories[ $#directories ]= '' ;
          return @directories ;
      }
  }
  
  
  =item catpath
  
  Takes volume, directory and file portions and returns an entire path. Under
  Unix, $volume is ignored, and this is just like catfile(). On other OSs,
  the $volume become significant.
  
  =cut
  
  sub catpath {
      my ($self,$volume,$directory,$file) = @_;
  
      # If it's UNC, make sure the glue separator is there, reusing
      # whatever separator is first in the $volume
      my $v;
      $volume .= $v
          if ( (($v) = $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s) &&
               $directory =~ m@^[^\\/]@s
             ) ;
  
      $volume .= $directory ;
  
      # If the volume is not just A:, make sure the glue separator is 
      # there, reusing whatever separator is first in the $volume if possible.
      if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s &&
           $volume =~ m@[^\\/]\Z(?!\n)@      &&
           $file   =~ m@[^\\/]@
         ) {
          $volume =~ m@([\\/])@ ;
          my $sep = $1 ? $1 : '\\' ;
          $volume .= $sep ;
      }
  
      $volume .= $file ;
  
      return $volume ;
  }
  
  sub _same {
    lc($_[1]) eq lc($_[2]);
  }
  
  sub rel2abs {
      my ($self,$path,$base ) = @_;
  
      my $is_abs = $self->file_name_is_absolute($path);
  
      # Check for volume (should probably document the '2' thing...)
      return $self->canonpath( $path ) if $is_abs == 2;
  
      if ($is_abs) {
        # It's missing a volume, add one
        my $vol = ($self->splitpath( $self->_cwd() ))[0];
        return $self->canonpath( $vol . $path );
      }
  
      if ( !defined( $base ) || $base eq '' ) {
        require Cwd ;
        $base = Cwd::getdcwd( ($self->splitpath( $path ))[0] ) if defined &Cwd::getdcwd ;
        $base = $self->_cwd() unless defined $base ;
      }
      elsif ( ! $self->file_name_is_absolute( $base ) ) {
        $base = $self->rel2abs( $base ) ;
      }
      else {
        $base = $self->canonpath( $base ) ;
      }
  
      my ( $path_directories, $path_file ) =
        ($self->splitpath( $path, 1 ))[1,2] ;
  
      my ( $base_volume, $base_directories ) =
        $self->splitpath( $base, 1 ) ;
  
      $path = $self->catpath( 
  			   $base_volume, 
  			   $self->catdir( $base_directories, $path_directories ), 
  			   $path_file
  			  ) ;
  
      return $self->canonpath( $path ) ;
  }
  
  =back
  
  =head2 Note For File::Spec::Win32 Maintainers
  
  Novell NetWare inherits its File::Spec behaviour from File::Spec::Win32.
  
  =head1 COPYRIGHT
  
  Copyright (c) 2004,2007 by the Perl 5 Porters.  All rights reserved.
  
  This program is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself.
  
  =head1 SEE ALSO
  
  See L<File::Spec> and L<File::Spec::Unix>.  This package overrides the
  implementation of these methods, not the semantics.
  
  =cut
  
  
  sub _canon_cat				# @path -> path
  {
      my ($first, @rest) = @_;
  
      my $volume = $first =~ s{ \A ([A-Za-z]:) ([\\/]?) }{}x	# drive letter
      	       ? ucfirst( $1 ).( $2 ? "\\" : "" )
  	       : $first =~ s{ \A (?:\\\\|//) ([^\\/]+)
  				 (?: [\\/] ([^\\/]+) )?
  	       			 [\\/]? }{}xs			# UNC volume
  	       ? "\\\\$1".( defined $2 ? "\\$2" : "" )."\\"
  	       : $first =~ s{ \A [\\/] }{}x			# root dir
  	       ? "\\"
  	       : "";
      my $path   = join "\\", $first, @rest;
  
      $path =~ tr#\\/#\\\\#s;		# xx/yy --> xx\yy & xx\\yy --> xx\yy
  
      					# xx/././yy --> xx/yy
      $path =~ s{(?:
  		(?:\A|\\)		# at begin or after a slash
  		\.
  		(?:\\\.)*		# and more
  		(?:\\|\z) 		# at end or followed by slash
  	       )+			# performance boost -- I do not know why
  	     }{\\}gx;
  
      # XXX I do not know whether more dots are supported by the OS supporting
      #     this ... annotation (NetWare or symbian but not MSWin32).
      #     Then .... could easily become ../../.. etc:
      # Replace \.\.\. by (\.\.\.+)  and substitute with
      # { $1 . ".." . "\\.." x (length($2)-2) }gex
  	     				# ... --> ../..
      $path =~ s{ (\A|\\)			# at begin or after a slash
      		\.\.\.
  		(?=\\|\z) 		# at end or followed by slash
  	     }{$1..\\..}gx;
      					# xx\yy\..\zz --> xx\zz
      while ( $path =~ s{(?:
  		(?:\A|\\)		# at begin or after a slash
  		[^\\]+			# rip this 'yy' off
  		\\\.\.
  		(?<!\A\.\.\\\.\.)	# do *not* replace ^..\..
  		(?<!\\\.\.\\\.\.)	# do *not* replace \..\..
  		(?:\\|\z) 		# at end or followed by slash
  	       )+			# performance boost -- I do not know why
  	     }{\\}sx ) {}
  
      $path =~ s#\A\\##;			# \xx --> xx  NOTE: this is *not* root
      $path =~ s#\\\z##;			# xx\ --> xx
  
      if ( $volume =~ m#\\\z# )
      {					# <vol>\.. --> <vol>\
  	$path =~ s{ \A			# at begin
  		    \.\.
  		    (?:\\\.\.)*		# and more
  		    (?:\\|\z) 		# at end or followed by slash
  		 }{}x;
  
  	return $1			# \\HOST\SHARE\ --> \\HOST\SHARE
  	    if    $path eq ""
  	      and $volume =~ m#\A(\\\\.*)\\\z#s;
      }
      return $path ne "" || $volume ? $volume.$path : ".";
  }
  
  1;
X86_64-LINUX_FILE_SPEC_WIN32

$fatpacked{"x86_64-linux/List/MoreUtils.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'X86_64-LINUX_LIST_MOREUTILS';
  package List::MoreUtils;
  
  use 5.00503;
  use strict;
  use Exporter   ();
  use DynaLoader ();
  
  use vars qw{ $VERSION @ISA @EXPORT_OK %EXPORT_TAGS };
  BEGIN {
      $VERSION   = '0.33';
      # $VERSION   = eval $VERSION;
      @ISA       = qw{ Exporter DynaLoader };
      @EXPORT_OK = qw{
          any all none notall true false
          firstidx first_index lastidx last_index
          insert_after insert_after_string
          apply indexes
          after after_incl before before_incl
          firstval first_value lastval last_value
          each_array each_arrayref
          pairwise natatime
          mesh zip uniq distinct
          minmax part
      };
      %EXPORT_TAGS = (
          all => \@EXPORT_OK,
      );
  
      # Load the XS at compile-time so that redefinition warnings will be
      # thrown correctly if the XS versions of part or indexes loaded
      eval {
          # PERL_DL_NONLAZY must be false, or any errors in loading will just
          # cause the perl code to be tested
          local $ENV{PERL_DL_NONLAZY} = 0 if $ENV{PERL_DL_NONLAZY};
  
          bootstrap List::MoreUtils $VERSION;
          1;
  
      } unless $ENV{LIST_MOREUTILS_PP};
  }
  
  eval <<'END_PERL' unless defined &any;
  
  # Use pure scalar boolean return values for compatibility with XS
  use constant YES => ! 0;
  use constant NO  => ! 1;
  
  sub any (&@) {
      my $f = shift;
      foreach ( @_ ) {
          return YES if $f->();
      }
      return NO;
  }
  
  sub all (&@) {
      my $f = shift;
      foreach ( @_ ) {
          return NO unless $f->();
      }
      return YES;
  }
  
  sub none (&@) {
      my $f = shift;
      foreach ( @_ ) {
          return NO if $f->();
      }
      return YES;
  }
  
  sub notall (&@) {
      my $f = shift;
      foreach ( @_ ) {
          return YES unless $f->();
      }
      return NO;
  }
  
  sub true (&@) {
      my $f     = shift;
      my $count = 0;
      foreach ( @_ ) {
          $count++ if $f->();
      }
      return $count;
  }
  
  sub false (&@) {
      my $f     = shift;
      my $count = 0;
      foreach ( @_ ) {
          $count++ unless $f->();
      }
      return $count;
  }
  
  sub firstidx (&@) {
      my $f = shift;
      foreach my $i ( 0 .. $#_ ) {
          local *_ = \$_[$i];
          return $i if $f->();
      }
      return -1;
  }
  
  sub lastidx (&@) {
      my $f = shift;
      foreach my $i ( reverse 0 .. $#_ ) {
          local *_ = \$_[$i];
          return $i if $f->();
      }
      return -1;
  }
  
  sub insert_after (&$\@) {
      my ($f, $val, $list) = @_;
      my $c = -1;
      local *_;
      foreach my $i ( 0 .. $#$list ) {
          $_ = $list->[$i];
          $c = $i, last if $f->();
      }
      @$list = (
          @{$list}[ 0 .. $c ],
          $val,
          @{$list}[ $c + 1 .. $#$list ],
      ) and return 1 if $c != -1;
      return 0;
  }
  
  sub insert_after_string ($$\@) {
      my ($string, $val, $list) = @_;
      my $c = -1;
      foreach my $i ( 0 .. $#$list ) {
          local $^W = 0;
          $c = $i, last if $string eq $list->[$i];
      }
      @$list = (
          @{$list}[ 0 .. $c ],
          $val,
          @{$list}[ $c + 1 .. $#$list ],
      ) and return 1 if $c != -1;
      return 0;
  }
  
  sub apply (&@) {
      my $action = shift;
      &$action foreach my @values = @_;
      wantarray ? @values : $values[-1];
  }
  
  sub after (&@) {
      my $test = shift;
      my $started;
      my $lag;
      grep $started ||= do {
          my $x = $lag;
          $lag = $test->();
          $x
      }, @_;
  }
  
  sub after_incl (&@) {
      my $test = shift;
      my $started;
      grep $started ||= $test->(), @_;
  }
  
  sub before (&@) {
      my $test = shift;
      my $more = 1;
      grep $more &&= ! $test->(), @_;
  }
  
  sub before_incl (&@) {
      my $test = shift;
      my $more = 1;
      my $lag  = 1;
      grep $more &&= do {
          my $x = $lag;
          $lag = ! $test->();
          $x
      }, @_;
  }
  
  sub indexes (&@) {
      my $test = shift;
      grep {
          local *_ = \$_[$_];
          $test->()
      } 0 .. $#_;
  }
  
  sub lastval (&@) {
      my $test = shift;
      my $ix;
      for ( $ix = $#_; $ix >= 0; $ix-- ) {
          local *_ = \$_[$ix];
          my $testval = $test->();
  
          # Simulate $_ as alias
          $_[$ix] = $_;
          return $_ if $testval;
      }
      return undef;
  }
  
  sub firstval (&@) {
      my $test = shift;
      foreach ( @_ ) {
          return $_ if $test->();
      }
      return undef;
  }
  
  sub pairwise (&\@\@) {
      my $op = shift;
  
      # Symbols for caller's input arrays
      use vars qw{ @A @B };
      local ( *A, *B ) = @_;
  
      # Localise $a, $b
      my ( $caller_a, $caller_b ) = do {
          my $pkg = caller();
          no strict 'refs';
          \*{$pkg.'::a'}, \*{$pkg.'::b'};
      };
  
      # Loop iteration limit
      my $limit = $#A > $#B? $#A : $#B;
  
      # This map expression is also the return value
      local( *$caller_a, *$caller_b );
      map {
          # Assign to $a, $b as refs to caller's array elements
          ( *$caller_a, *$caller_b ) = \( $A[$_], $B[$_] );
  
          # Perform the transformation
          $op->();
      }  0 .. $limit;
  }
  
  sub each_array (\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@) {
      return each_arrayref(@_);
  }
  
  sub each_arrayref {
      my @list  = @_; # The list of references to the arrays
      my $index = 0;  # Which one the caller will get next
      my $max   = 0;  # Number of elements in longest array
  
      # Get the length of the longest input array
      foreach ( @list ) {
          unless ( ref $_ eq 'ARRAY' ) {
              require Carp;
              Carp::croak("each_arrayref: argument is not an array reference\n");
          }
          $max = @$_ if @$_ > $max;
      }
  
      # Return the iterator as a closure wrt the above variables.
      return sub {
          if ( @_ ) {
              my $method = shift;
              unless ( $method eq 'index' ) {
                  require Carp;
                  Carp::croak("each_array: unknown argument '$method' passed to iterator.");
              }
  
              # Return current (last fetched) index
              return undef if $index == 0  ||  $index > $max;
              return $index - 1;
          }
  
          # No more elements to return
          return if $index >= $max;
          my $i = $index++;
  
          # Return ith elements
          return map $_->[$i], @list; 
      }
  }
  
  sub natatime ($@) {
      my $n    = shift;
      my @list = @_;
      return sub {
          return splice @list, 0, $n;
      }
  }
  
  sub mesh (\@\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@) {
      my $max = -1;
      $max < $#$_ && ( $max = $#$_ ) foreach @_;
      map {
          my $ix = $_;
          map $_->[$ix], @_;
      } 0 .. $max; 
  }
  
  sub uniq (@) {
      my %seen = ();
      grep { not $seen{$_}++ } @_;
  }
  
  sub minmax (@) {
      return unless @_;
      my $min = my $max = $_[0];
  
      for ( my $i = 1; $i < @_; $i += 2 ) {
          if ( $_[$i-1] <= $_[$i] ) {
              $min = $_[$i-1] if $min > $_[$i-1];
              $max = $_[$i]   if $max < $_[$i];
          } else {
              $min = $_[$i]   if $min > $_[$i];
              $max = $_[$i-1] if $max < $_[$i-1];
          }
      }
  
      if ( @_ & 1 ) {
          my $i = $#_;
          if ($_[$i-1] <= $_[$i]) {
              $min = $_[$i-1] if $min > $_[$i-1];
              $max = $_[$i]   if $max < $_[$i];
          } else {
              $min = $_[$i]   if $min > $_[$i];
              $max = $_[$i-1] if $max < $_[$i-1];
          }
      }
  
      return ($min, $max);
  }
  
  sub part (&@) {
      my ($code, @list) = @_;
      my @parts;
      push @{ $parts[ $code->($_) ] }, $_  foreach @list;
      return @parts;
  }
  
  sub _XScompiled {
      return 0;
  }
  
  END_PERL
  die $@ if $@;
  
  # Function aliases
  *first_index = \&firstidx;
  *last_index  = \&lastidx;
  *first_value = \&firstval;
  *last_value  = \&lastval;
  *zip         = \&mesh;
  *distinct    = \&uniq;
  
  1;
  
  __END__
  
  =pod
  
  =head1 NAME
  
  List::MoreUtils - Provide the stuff missing in List::Util
  
  =head1 SYNOPSIS
  
      use List::MoreUtils qw{
          any all none notall true false
          firstidx first_index lastidx last_index
          insert_after insert_after_string
          apply indexes
          after after_incl before before_incl
          firstval first_value lastval last_value
          each_array each_arrayref
          pairwise natatime
          mesh zip uniq distinct minmax part
      };
  
  =head1 DESCRIPTION
  
  B<List::MoreUtils> provides some trivial but commonly needed functionality on
  lists which is not going to go into L<List::Util>.
  
  All of the below functions are implementable in only a couple of lines of Perl
  code. Using the functions from this module however should give slightly better
  performance as everything is implemented in C. The pure-Perl implementation of
  these functions only serves as a fallback in case the C portions of this module
  couldn't be compiled on this machine.
  
  =over 4
  
  =item any BLOCK LIST
  
  Returns a true value if any item in LIST meets the criterion given through
  BLOCK. Sets C<$_> for each item in LIST in turn:
  
      print "At least one value undefined"
          if any { ! defined($_) } @list;
  
  Returns false otherwise, or if LIST is empty.
  
  =item all BLOCK LIST
  
  Returns a true value if all items in LIST meet the criterion given through
  BLOCK, or if LIST is empty. Sets C<$_> for each item in LIST in turn:
  
      print "All items defined"
          if all { defined($_) } @list;
  
  Returns false otherwise.
  
  =item none BLOCK LIST
  
  Logically the negation of C<any>. Returns a true value if no item in LIST meets
  the criterion given through BLOCK, or if LIST is empty. Sets C<$_> for each item
  in LIST in turn:
  
      print "No value defined"
          if none { defined($_) } @list;
  
  Returns false otherwise.
  
  =item notall BLOCK LIST
  
  Logically the negation of C<all>. Returns a true value if not all items in LIST
  meet the criterion given through BLOCK. Sets C<$_> for each item in LIST in
  turn:
  
      print "Not all values defined"
          if notall { defined($_) } @list;
  
  Returns false otherwise, or if LIST is empty.
  
  =item true BLOCK LIST
  
  Counts the number of elements in LIST for which the criterion in BLOCK is true.
  Sets C<$_> for  each item in LIST in turn:
  
      printf "%i item(s) are defined", true { defined($_) } @list;
  
  =item false BLOCK LIST
  
  Counts the number of elements in LIST for which the criterion in BLOCK is false.
  Sets C<$_> for each item in LIST in turn:
  
      printf "%i item(s) are not defined", false { defined($_) } @list;
  
  =item firstidx BLOCK LIST
  
  =item first_index BLOCK LIST
  
  Returns the index of the first element in LIST for which the criterion in BLOCK
  is true. Sets C<$_> for each item in LIST in turn:
  
      my @list = (1, 4, 3, 2, 4, 6);
      printf "item with index %i in list is 4", firstidx { $_ == 4 } @list;
      __END__
      item with index 1 in list is 4
      
  Returns C<-1> if no such item could be found.
  
  C<first_index> is an alias for C<firstidx>.
  
  =item lastidx BLOCK LIST
  
  =item last_index BLOCK LIST
  
  Returns the index of the last element in LIST for which the criterion in BLOCK
  is true. Sets C<$_> for each item in LIST in turn:
  
      my @list = (1, 4, 3, 2, 4, 6);
      printf "item with index %i in list is 4", lastidx { $_ == 4 } @list;
      __END__
      item with index 4 in list is 4
  
  Returns C<-1> if no such item could be found.
  
  C<last_index> is an alias for C<lastidx>.
  
  =item insert_after BLOCK VALUE LIST
  
  Inserts VALUE after the first item in LIST for which the criterion in BLOCK is
  true. Sets C<$_> for each item in LIST in turn.
  
      my @list = qw/This is a list/;
      insert_after { $_ eq "a" } "longer" => @list;
      print "@list";
      __END__
      This is a longer list
  
  =item insert_after_string STRING VALUE LIST
  
  Inserts VALUE after the first item in LIST which is equal to STRING. 
  
      my @list = qw/This is a list/;
      insert_after_string "a", "longer" => @list;
      print "@list";
      __END__
      This is a longer list
  
  =item apply BLOCK LIST
  
  Applies BLOCK to each item in LIST and returns a list of the values after BLOCK
  has been applied. In scalar context, the last element is returned.  This
  function is similar to C<map> but will not modify the elements of the input
  list:
  
      my @list = (1 .. 4);
      my @mult = apply { $_ *= 2 } @list;
      print "\@list = @list\n";
      print "\@mult = @mult\n";
      __END__
      @list = 1 2 3 4
      @mult = 2 4 6 8
  
  Think of it as syntactic sugar for
  
      for (my @mult = @list) { $_ *= 2 }
  
  =item before BLOCK LIST
  
  Returns a list of values of LIST upto (and not including) the point where BLOCK
  returns a true value. Sets C<$_> for each element in LIST in turn.
  
  =item before_incl BLOCK LIST
  
  Same as C<before> but also includes the element for which BLOCK is true.
  
  =item after BLOCK LIST
  
  Returns a list of the values of LIST after (and not including) the point
  where BLOCK returns a true value. Sets C<$_> for each element in LIST in turn.
  
      @x = after { $_ % 5 == 0 } (1..9);    # returns 6, 7, 8, 9
  
  =item after_incl BLOCK LIST
  
  Same as C<after> but also inclues the element for which BLOCK is true.
  
  =item indexes BLOCK LIST
  
  Evaluates BLOCK for each element in LIST (assigned to C<$_>) and returns a list
  of the indices of those elements for which BLOCK returned a true value. This is
  just like C<grep> only that it returns indices instead of values:
  
      @x = indexes { $_ % 2 == 0 } (1..10);   # returns 1, 3, 5, 7, 9
  
  =item firstval BLOCK LIST
  
  =item first_value BLOCK LIST
  
  Returns the first element in LIST for which BLOCK evaluates to true. Each
  element of LIST is set to C<$_> in turn. Returns C<undef> if no such element
  has been found.
  
  C<first_val> is an alias for C<firstval>.
  
  =item lastval BLOCK LIST
  
  =item last_value BLOCK LIST
  
  Returns the last value in LIST for which BLOCK evaluates to true. Each element
  of LIST is set to C<$_> in turn. Returns C<undef> if no such element has been
  found.
  
  C<last_val> is an alias for C<lastval>.
  
  =item pairwise BLOCK ARRAY1 ARRAY2
  
  Evaluates BLOCK for each pair of elements in ARRAY1 and ARRAY2 and returns a
  new list consisting of BLOCK's return values. The two elements are set to C<$a>
  and C<$b>.  Note that those two are aliases to the original value so changing
  them will modify the input arrays.
  
      @a = (1 .. 5);
      @b = (11 .. 15);
      @x = pairwise { $a + $b } @a, @b;	# returns 12, 14, 16, 18, 20
  
      # mesh with pairwise
      @a = qw/a b c/;
      @b = qw/1 2 3/;
      @x = pairwise { ($a, $b) } @a, @b;	# returns a, 1, b, 2, c, 3
  
  =item each_array ARRAY1 ARRAY2 ...
  
  Creates an array iterator to return the elements of the list of arrays ARRAY1,
  ARRAY2 throughout ARRAYn in turn.  That is, the first time it is called, it
  returns the first element of each array.  The next time, it returns the second
  elements.  And so on, until all elements are exhausted.
  
  This is useful for looping over more than one array at once:
  
      my $ea = each_array(@a, @b, @c);
      while ( my ($a, $b, $c) = $ea->() )   { .... }
  
  The iterator returns the empty list when it reached the end of all arrays.
  
  If the iterator is passed an argument of 'C<index>', then it retuns
  the index of the last fetched set of values, as a scalar.
  
  =item each_arrayref LIST
  
  Like each_array, but the arguments are references to arrays, not the
  plain arrays.
  
  =item natatime EXPR, LIST
  
  Creates an array iterator, for looping over an array in chunks of
  C<$n> items at a time.  (n at a time, get it?).  An example is
  probably a better explanation than I could give in words.
  
  Example:
  
      my @x = ('a' .. 'g');
      my $it = natatime 3, @x;
      while (my @vals = $it->())
      {
          print "@vals\n";
      }
  
  This prints
  
      a b c
      d e f
      g
  
  =item mesh ARRAY1 ARRAY2 [ ARRAY3 ... ]
  
  =item zip ARRAY1 ARRAY2 [ ARRAY3 ... ]
  
  Returns a list consisting of the first elements of each array, then
  the second, then the third, etc, until all arrays are exhausted.
  
  Examples:
  
      @x = qw/a b c d/;
      @y = qw/1 2 3 4/;
      @z = mesh @x, @y;	    # returns a, 1, b, 2, c, 3, d, 4
  
      @a = ('x');
      @b = ('1', '2');
      @c = qw/zip zap zot/;
      @d = mesh @a, @b, @c;   # x, 1, zip, undef, 2, zap, undef, undef, zot
  
  C<zip> is an alias for C<mesh>.
  
  =item uniq LIST
  
  =item distinct LIST
  
  Returns a new list by stripping duplicate values in LIST. The order of
  elements in the returned list is the same as in LIST. In scalar context,
  returns the number of unique elements in LIST.
  
      my @x = uniq 1, 1, 2, 2, 3, 5, 3, 4; # returns 1 2 3 5 4
      my $x = uniq 1, 1, 2, 2, 3, 5, 3, 4; # returns 5
  
  =item minmax LIST
  
  Calculates the minimum and maximum of LIST and returns a two element list with
  the first element being the minimum and the second the maximum. Returns the
  empty list if LIST was empty.
  
  The C<minmax> algorithm differs from a naive iteration over the list where each
  element is compared to two values being the so far calculated min and max value
  in that it only requires 3n/2 - 2 comparisons. Thus it is the most efficient
  possible algorithm.
  
  However, the Perl implementation of it has some overhead simply due to the fact
  that there are more lines of Perl code involved. Therefore, LIST needs to be
  fairly big in order for C<minmax> to win over a naive implementation. This
  limitation does not apply to the XS version.
  
  =item part BLOCK LIST
  
  Partitions LIST based on the return value of BLOCK which denotes into which
  partition the current value is put.
  
  Returns a list of the partitions thusly created. Each partition created is a
  reference to an array.
  
      my $i = 0;
      my @part = part { $i++ % 2 } 1 .. 8;   # returns [1, 3, 5, 7], [2, 4, 6, 8]
  
  You can have a sparse list of partitions as well where non-set partitions will
  be undef:
  
      my @part = part { 2 } 1 .. 10;	    # returns undef, undef, [ 1 .. 10 ]
  
  Be careful with negative values, though:
  
      my @part = part { -1 } 1 .. 10;
      __END__
      Modification of non-creatable array value attempted, subscript -1 ...
  
  Negative values are only ok when they refer to a partition previously created:
  
      my @idx  = ( 0, 1, -1 );
      my $i    = 0;
      my @part = part { $idx[$++ % 3] } 1 .. 8; # [1, 4, 7], [2, 3, 5, 6, 8]
  
  =back
  
  =head1 EXPORTS
  
  Nothing by default. To import all of this module's symbols, do the conventional
  
      use List::MoreUtils ':all';
  
  It may make more sense though to only import the stuff your program actually
  needs:
  
      use List::MoreUtils qw{ any firstidx };
  
  =head1 ENVIRONMENT
  
  When C<LIST_MOREUTILS_PP> is set, the module will always use the pure-Perl
  implementation and not the XS one. This environment variable is really just
  there for the test-suite to force testing the Perl implementation, and possibly
  for reporting of bugs. I don't see any reason to use it in a production
  environment.
  
  =head1 BUGS
  
  There is a problem with a bug in 5.6.x perls. It is a syntax error to write
  things like:
  
      my @x = apply { s/foo/bar/ } qw{ foo bar baz };
  
  It has to be written as either
  
      my @x = apply { s/foo/bar/ } 'foo', 'bar', 'baz';
  
  or
  
      my @x = apply { s/foo/bar/ } my @dummy = qw/foo bar baz/;
  
  Perl 5.5.x and Perl 5.8.x don't suffer from this limitation.
  
  If you have a functionality that you could imagine being in this module, please
  drop me a line. This module's policy will be less strict than L<List::Util>'s
  when it comes to additions as it isn't a core module.
  
  When you report bugs, it would be nice if you could additionally give me the
  output of your program with the environment variable C<LIST_MOREUTILS_PP> set
  to a true value. That way I know where to look for the problem (in XS,
  pure-Perl or possibly both).
  
  =head1 SUPPORT
  
  Bugs should always be submitted via the CPAN bug tracker.
  
  L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=List-MoreUtils>
  
  =head1 THANKS
  
  Credits go to a number of people: Steve Purkis for giving me namespace advice
  and James Keenan and Terrence Branno for their effort of keeping the CPAN
  tidier by making L<List::Utils> obsolete. 
  
  Brian McCauley suggested the inclusion of apply() and provided the pure-Perl
  implementation for it.
  
  Eric J. Roode asked me to add all functions from his module C<List::MoreUtil>
  into this one. With minor modifications, the pure-Perl implementations of those
  are by him.
  
  The bunch of people who almost immediately pointed out the many problems with
  the glitchy 0.07 release (Slaven Rezic, Ron Savage, CPAN testers).
  
  A particularly nasty memory leak was spotted by Thomas A. Lowery.
  
  Lars Thegler made me aware of problems with older Perl versions.
  
  Anno Siegel de-orphaned each_arrayref().
  
  David Filmer made me aware of a problem in each_arrayref that could ultimately
  lead to a segfault.
  
  Ricardo Signes suggested the inclusion of part() and provided the
  Perl-implementation.
  
  Robin Huston kindly fixed a bug in perl's MULTICALL API to make the
  XS-implementation of part() work.
  
  =head1 TODO
  
  A pile of requests from other people is still pending further processing in
  my mailbox. This includes:
  
  =over 4
  
  =item * List::Util export pass-through
  
  Allow B<List::MoreUtils> to pass-through the regular L<List::Util>
  functions to end users only need to C<use> the one module.
  
  =item * uniq_by(&@)
  
  Use code-reference to extract a key based on which the uniqueness is
  determined. Suggested by Aaron Crane.
  
  =item * delete_index
  
  =item * random_item
  
  =item * random_item_delete_index
  
  =item * list_diff_hash
  
  =item * list_diff_inboth
  
  =item * list_diff_infirst
  
  =item * list_diff_insecond
  
  These were all suggested by Dan Muey.
  
  =item * listify
  
  Always return a flat list when either a simple scalar value was passed or an
  array-reference. Suggested by Mark Summersault.
  
  =back
  
  =head1 SEE ALSO
  
  L<List::Util>
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  Tassilo von Parseval E<lt>tassilo.von.parseval@rwth-aachen.deE<gt>
  
  =head1 COPYRIGHT AND LICENSE
  
  Some parts copyright 2011 Aaron Crane.
  
  Copyright 2004 - 2010 by Tassilo von Parseval
  
  This library is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself, either Perl version 5.8.4 or,
  at your option, any later version of Perl 5 you may have available.
  
  =cut
X86_64-LINUX_LIST_MOREUTILS

$fatpacked{"x86_64-linux/Params/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'X86_64-LINUX_PARAMS_UTIL';
  package Params::Util;
  
  =pod
  
  =head1 NAME
  
  Params::Util - Simple, compact and correct param-checking functions
  
  =head1 SYNOPSIS
  
    # Import some functions
    use Params::Util qw{_SCALAR _HASH _INSTANCE};
    
    # If you are lazy, or need a lot of them...
    use Params::Util ':ALL';
    
    sub foo {
        my $object  = _INSTANCE(shift, 'Foo') or return undef;
        my $image   = _SCALAR(shift)          or return undef;
        my $options = _HASH(shift)            or return undef;
        # etc...
    }
  
  =head1 DESCRIPTION
  
  C<Params::Util> provides a basic set of importable functions that makes
  checking parameters a hell of a lot easier
  
  While they can be (and are) used in other contexts, the main point
  behind this module is that the functions B<both> Do What You Mean,
  and Do The Right Thing, so they are most useful when you are getting
  params passed into your code from someone and/or somewhere else
  and you can't really trust the quality.
  
  Thus, C<Params::Util> is of most use at the edges of your API, where
  params and data are coming in from outside your code.
  
  The functions provided by C<Params::Util> check in the most strictly
  correct manner known, are documented as thoroughly as possible so their
  exact behaviour is clear, and heavily tested so make sure they are not
  fooled by weird data and Really Bad Things.
  
  To use, simply load the module providing the functions you want to use
  as arguments (as shown in the SYNOPSIS).
  
  To aid in maintainability, C<Params::Util> will B<never> export by
  default.
  
  You must explicitly name the functions you want to export, or use the
  C<:ALL> param to just have it export everything (although this is not
  recommended if you have any _FOO functions yourself with which future
  additions to C<Params::Util> may clash)
  
  =head1 FUNCTIONS
  
  =cut
  
  use 5.00503;
  use strict;
  require overload;
  require Exporter;
  require Scalar::Util;
  require DynaLoader;
  
  use vars qw{$VERSION @ISA @EXPORT_OK %EXPORT_TAGS};
  
  $VERSION   = '1.07';
  @ISA       = qw{
  	Exporter
  	DynaLoader
  };
  @EXPORT_OK = qw{
  	_STRING     _IDENTIFIER
  	_CLASS      _CLASSISA   _SUBCLASS  _DRIVER  _CLASSDOES
  	_NUMBER     _POSINT     _NONNEGINT
  	_SCALAR     _SCALAR0
  	_ARRAY      _ARRAY0     _ARRAYLIKE
  	_HASH       _HASH0      _HASHLIKE
  	_CODE       _CODELIKE
  	_INVOCANT   _REGEX      _INSTANCE  _INSTANCEDOES
  	_SET        _SET0
  	_HANDLE
  };
  %EXPORT_TAGS = ( ALL => \@EXPORT_OK );
  
  eval {
  	local $ENV{PERL_DL_NONLAZY} = 0 if $ENV{PERL_DL_NONLAZY};
  	bootstrap Params::Util $VERSION;
  	1;
  } unless $ENV{PERL_PARAMS_UTIL_PP};
  
  # Use a private pure-perl copy of looks_like_number if the version of
  # Scalar::Util is old (for whatever reason).
  my $SU = eval "$Scalar::Util::VERSION" || 0;
  if ( $SU >= 1.18 ) { 
  	Scalar::Util->import('looks_like_number');
  } else {
  	eval <<'END_PERL';
  sub looks_like_number {
  	local $_ = shift;
  
  	# checks from perlfaq4
  	return 0 if !defined($_);
  	if (ref($_)) {
  		return overload::Overloaded($_) ? defined(0 + $_) : 0;
  	}
  	return 1 if (/^[+-]?[0-9]+$/); # is a +/- integer
  	return 1 if (/^([+-]?)(?=[0-9]|\.[0-9])[0-9]*(\.[0-9]*)?([Ee]([+-]?[0-9]+))?$/); # a C float
  	return 1 if ($] >= 5.008 and /^(Inf(inity)?|NaN)$/i) or ($] >= 5.006001 and /^Inf$/i);
  
  	0;
  }
  END_PERL
  }
  
  
  
  
  
  #####################################################################
  # Param Checking Functions
  
  =pod
  
  =head2 _STRING $string
  
  The C<_STRING> function is intended to be imported into your
  package, and provides a convenient way to test to see if a value is
  a normal non-false string of non-zero length.
  
  Note that this will NOT do anything magic to deal with the special
  C<'0'> false negative case, but will return it.
  
    # '0' not considered valid data
    my $name = _STRING(shift) or die "Bad name";
    
    # '0' is considered valid data
    my $string = _STRING($_[0]) ? shift : die "Bad string";
  
  Please also note that this function expects a normal string. It does
  not support overloading or other magic techniques to get a string.
  
  Returns the string as a conveince if it is a valid string, or
  C<undef> if not.
  
  =cut
  
  eval <<'END_PERL' unless defined &_STRING;
  sub _STRING ($) {
  	(defined $_[0] and ! ref $_[0] and length($_[0])) ? $_[0] : undef;
  }
  END_PERL
  
  =pod
  
  =head2 _IDENTIFIER $string
  
  The C<_IDENTIFIER> function is intended to be imported into your
  package, and provides a convenient way to test to see if a value is
  a string that is a valid Perl identifier.
  
  Returns the string as a convenience if it is a valid identifier, or
  C<undef> if not.
  
  =cut
  
  eval <<'END_PERL' unless defined &_IDENTIFIER;
  sub _IDENTIFIER ($) {
  	(defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*\z/s) ? $_[0] : undef;
  }
  END_PERL
  
  =pod
  
  =head2 _CLASS $string
  
  The C<_CLASS> function is intended to be imported into your
  package, and provides a convenient way to test to see if a value is
  a string that is a valid Perl class.
  
  This function only checks that the format is valid, not that the
  class is actually loaded. It also assumes "normalised" form, and does
  not accept class names such as C<::Foo> or C<D'Oh>.
  
  Returns the string as a convenience if it is a valid class name, or
  C<undef> if not.
  
  =cut
  
  eval <<'END_PERL' unless defined &_CLASS;
  sub _CLASS ($) {
  	(defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s) ? $_[0] : undef;
  }
  END_PERL
  
  =pod
  
  =head2 _CLASSISA $string, $class
  
  The C<_CLASSISA> function is intended to be imported into your
  package, and provides a convenient way to test to see if a value is
  a string that is a particularly class, or a subclass of it.
  
  This function checks that the format is valid and calls the -E<gt>isa
  method on the class name. It does not check that the class is actually
  loaded.
  
  It also assumes "normalised" form, and does
  not accept class names such as C<::Foo> or C<D'Oh>.
  
  Returns the string as a convenience if it is a valid class name, or
  C<undef> if not.
  
  =cut
  
  eval <<'END_PERL' unless defined &_CLASSISA;
  sub _CLASSISA ($$) {
  	(defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s and $_[0]->isa($_[1])) ? $_[0] : undef;
  }
  END_PERL
  
  =head2 _CLASSDOES $string, $role
  
  This routine behaves exactly like C<L</_CLASSISA>>, but checks with C<< ->DOES
  >> rather than C<< ->isa >>.  This is probably only a good idea to use on Perl
  5.10 or later, when L<UNIVERSAL::DOES|UNIVERSAL::DOES/DOES> has been
  implemented.
  
  =cut
  
  eval <<'END_PERL' unless defined &_CLASSDOES;
  sub _CLASSDOES ($$) {
  	(defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s and $_[0]->DOES($_[1])) ? $_[0] : undef;
  }
  END_PERL
  
  =pod
  
  =head2 _SUBCLASS $string, $class
  
  The C<_SUBCLASS> function is intended to be imported into your
  package, and provides a convenient way to test to see if a value is
  a string that is a subclass of a specified class.
  
  This function checks that the format is valid and calls the -E<gt>isa
  method on the class name. It does not check that the class is actually
  loaded.
  
  It also assumes "normalised" form, and does
  not accept class names such as C<::Foo> or C<D'Oh>.
  
  Returns the string as a convenience if it is a valid class name, or
  C<undef> if not.
  
  =cut
  
  eval <<'END_PERL' unless defined &_SUBCLASS;
  sub _SUBCLASS ($$) {
  	(defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s and $_[0] ne $_[1] and $_[0]->isa($_[1])) ? $_[0] : undef;
  }
  END_PERL
  
  =pod
  
  =head2 _NUMBER $scalar
  
  The C<_NUMBER> function is intended to be imported into your
  package, and provides a convenient way to test to see if a value is
  a number. That is, it is defined and perl thinks it's a number.
  
  This function is basically a Params::Util-style wrapper around the
  L<Scalar::Util> C<looks_like_number> function.
  
  Returns the value as a convience, or C<undef> if the value is not a
  number.
  
  =cut
  
  eval <<'END_PERL' unless defined &_NUMBER;
  sub _NUMBER ($) {
  	( defined $_[0] and ! ref $_[0] and looks_like_number($_[0]) )
  	? $_[0]
  	: undef;
  }
  END_PERL
  
  =pod
  
  =head2 _POSINT $integer
  
  The C<_POSINT> function is intended to be imported into your
  package, and provides a convenient way to test to see if a value is
  a positive integer (of any length).
  
  Returns the value as a convience, or C<undef> if the value is not a
  positive integer.
  
  The name itself is derived from the XML schema constraint of the same
  name.
  
  =cut
  
  eval <<'END_PERL' unless defined &_POSINT;
  sub _POSINT ($) {
  	(defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[1-9]\d*$/) ? $_[0] : undef;
  }
  END_PERL
  
  =pod
  
  =head2 _NONNEGINT $integer
  
  The C<_NONNEGINT> function is intended to be imported into your
  package, and provides a convenient way to test to see if a value is
  a non-negative integer (of any length). That is, a positive integer,
  or zero.
  
  Returns the value as a convience, or C<undef> if the value is not a
  non-negative integer.
  
  As with other tests that may return false values, care should be taken
  to test via "defined" in boolean validy contexts.
  
    unless ( defined _NONNEGINT($value) ) {
       die "Invalid value";
    }
  
  The name itself is derived from the XML schema constraint of the same
  name.
  
  =cut
  
  eval <<'END_PERL' unless defined &_NONNEGINT;
  sub _NONNEGINT ($) {
  	(defined $_[0] and ! ref $_[0] and $_[0] =~ m/^(?:0|[1-9]\d*)$/) ? $_[0] : undef;
  }
  END_PERL
  
  =pod
  
  =head2 _SCALAR \$scalar
  
  The C<_SCALAR> function is intended to be imported into your package,
  and provides a convenient way to test for a raw and unblessed
  C<SCALAR> reference, with content of non-zero length.
  
  For a version that allows zero length C<SCALAR> references, see
  the C<_SCALAR0> function.
  
  Returns the C<SCALAR> reference itself as a convenience, or C<undef>
  if the value provided is not a C<SCALAR> reference.
  
  =cut
  
  eval <<'END_PERL' unless defined &_SCALAR;
  sub _SCALAR ($) {
  	(ref $_[0] eq 'SCALAR' and defined ${$_[0]} and ${$_[0]} ne '') ? $_[0] : undef;
  }
  END_PERL
  
  =pod
  
  =head2 _SCALAR0 \$scalar
  
  The C<_SCALAR0> function is intended to be imported into your package,
  and provides a convenient way to test for a raw and unblessed
  C<SCALAR0> reference, allowing content of zero-length.
  
  For a simpler "give me some content" version that requires non-zero
  length, C<_SCALAR> function.
  
  Returns the C<SCALAR> reference itself as a convenience, or C<undef>
  if the value provided is not a C<SCALAR> reference.
  
  =cut
  
  eval <<'END_PERL' unless defined &_SCALAR0;
  sub _SCALAR0 ($) {
  	ref $_[0] eq 'SCALAR' ? $_[0] : undef;
  }
  END_PERL
  
  =pod
  
  =head2 _ARRAY $value
  
  The C<_ARRAY> function is intended to be imported into your package,
  and provides a convenient way to test for a raw and unblessed
  C<ARRAY> reference containing B<at least> one element of any kind.
  
  For a more basic form that allows zero length ARRAY references, see
  the C<_ARRAY0> function.
  
  Returns the C<ARRAY> reference itself as a convenience, or C<undef>
  if the value provided is not an C<ARRAY> reference.
  
  =cut
  
  eval <<'END_PERL' unless defined &_ARRAY;
  sub _ARRAY ($) {
  	(ref $_[0] eq 'ARRAY' and @{$_[0]}) ? $_[0] : undef;
  }
  END_PERL
  
  =pod
  
  =head2 _ARRAY0 $value
  
  The C<_ARRAY0> function is intended to be imported into your package,
  and provides a convenient way to test for a raw and unblessed
  C<ARRAY> reference, allowing C<ARRAY> references that contain no
  elements.
  
  For a more basic "An array of something" form that also requires at
  least one element, see the C<_ARRAY> function.
  
  Returns the C<ARRAY> reference itself as a convenience, or C<undef>
  if the value provided is not an C<ARRAY> reference.
  
  =cut
  
  eval <<'END_PERL' unless defined &_ARRAY0;
  sub _ARRAY0 ($) {
  	ref $_[0] eq 'ARRAY' ? $_[0] : undef;
  }
  END_PERL
  
  =pod
  
  =head2 _ARRAYLIKE $value
  
  The C<_ARRAYLIKE> function tests whether a given scalar value can respond to
  array dereferencing.  If it can, the value is returned.  If it cannot,
  C<_ARRAYLIKE> returns C<undef>.
  
  =cut
  
  eval <<'END_PERL' unless defined &_ARRAYLIKE;
  sub _ARRAYLIKE {
  	(defined $_[0] and ref $_[0] and (
  		(Scalar::Util::reftype($_[0]) eq 'ARRAY')
  		or
  		overload::Method($_[0], '@{}')
  	)) ? $_[0] : undef;
  }
  END_PERL
  
  =pod
  
  =head2 _HASH $value
  
  The C<_HASH> function is intended to be imported into your package,
  and provides a convenient way to test for a raw and unblessed
  C<HASH> reference with at least one entry.
  
  For a version of this function that allows the C<HASH> to be empty,
  see the C<_HASH0> function.
  
  Returns the C<HASH> reference itself as a convenience, or C<undef>
  if the value provided is not an C<HASH> reference.
  
  =cut
  
  eval <<'END_PERL' unless defined &_HASH;
  sub _HASH ($) {
  	(ref $_[0] eq 'HASH' and scalar %{$_[0]}) ? $_[0] : undef;
  }
  END_PERL
  
  =pod
  
  =head2 _HASH0 $value
  
  The C<_HASH0> function is intended to be imported into your package,
  and provides a convenient way to test for a raw and unblessed
  C<HASH> reference, regardless of the C<HASH> content.
  
  For a simpler "A hash of something" version that requires at least one
  element, see the C<_HASH> function.
  
  Returns the C<HASH> reference itself as a convenience, or C<undef>
  if the value provided is not an C<HASH> reference.
  
  =cut
  
  eval <<'END_PERL' unless defined &_HASH0;
  sub _HASH0 ($) {
  	ref $_[0] eq 'HASH' ? $_[0] : undef;
  }
  END_PERL
  
  =pod
  
  =head2 _HASHLIKE $value
  
  The C<_HASHLIKE> function tests whether a given scalar value can respond to
  hash dereferencing.  If it can, the value is returned.  If it cannot,
  C<_HASHLIKE> returns C<undef>.
  
  =cut
  
  eval <<'END_PERL' unless defined &_HASHLIKE;
  sub _HASHLIKE {
  	(defined $_[0] and ref $_[0] and (
  		(Scalar::Util::reftype($_[0]) eq 'HASH')
  		or
  		overload::Method($_[0], '%{}')
  	)) ? $_[0] : undef;
  }
  END_PERL
  
  =pod
  
  =head2 _CODE $value
  
  The C<_CODE> function is intended to be imported into your package,
  and provides a convenient way to test for a raw and unblessed
  C<CODE> reference.
  
  Returns the C<CODE> reference itself as a convenience, or C<undef>
  if the value provided is not an C<CODE> reference.
  
  =cut
  
  eval <<'END_PERL' unless defined &_CODE;
  sub _CODE ($) {
  	ref $_[0] eq 'CODE' ? $_[0] : undef;
  }
  END_PERL
  
  =pod
  
  =head2 _CODELIKE $value
  
  The C<_CODELIKE> is the more generic version of C<_CODE>. Unlike C<_CODE>,
  which checks for an explicit C<CODE> reference, the C<_CODELIKE> function
  also includes things that act like them, such as blessed objects that
  overload C<'&{}'>.
  
  Please note that in the case of objects overloaded with '&{}', you will
  almost always end up also testing it in 'bool' context at some stage.
  
  For example:
  
    sub foo {
        my $code1 = _CODELIKE(shift) or die "No code param provided";
        my $code2 = _CODELIKE(shift);
        if ( $code2 ) {
             print "Got optional second code param";
        }
    }
  
  As such, you will most likely always want to make sure your class has
  at least the following to allow it to evaluate to true in boolean
  context.
  
    # Always evaluate to true in boolean context
    use overload 'bool' => sub () { 1 };
  
  Returns the callable value as a convenience, or C<undef> if the
  value provided is not callable.
  
  Note - This function was formerly known as _CALLABLE but has been renamed
  for greater symmetry with the other _XXXXLIKE functions.
  
  The use of _CALLABLE has been deprecated. It will continue to work, but
  with a warning, until end-2006, then will be removed.
  
  I apologise for any inconvenience caused.
  
  =cut
  
  eval <<'END_PERL' unless defined &_CODELIKE;
  sub _CODELIKE($) {
  	(
  		(Scalar::Util::reftype($_[0])||'') eq 'CODE'
  		or
  		Scalar::Util::blessed($_[0]) and overload::Method($_[0],'&{}')
  	)
  	? $_[0] : undef;
  }
  END_PERL
  
  =pod
  
  =head2 _INVOCANT $value
  
  This routine tests whether the given value is a valid method invocant.
  This can be either an instance of an object, or a class name.
  
  If so, the value itself is returned.  Otherwise, C<_INVOCANT>
  returns C<undef>.
  
  =cut
  
  eval <<'END_PERL' unless defined &_INVOCANT;
  sub _INVOCANT($) {
  	(defined $_[0] and
  		(defined Scalar::Util::blessed($_[0])
  		or      
  		# We used to check for stash definedness, but any class-like name is a
  		# valid invocant for UNIVERSAL methods, so we stopped. -- rjbs, 2006-07-02
  		Params::Util::_CLASS($_[0]))
  	) ? $_[0] : undef;
  }
  END_PERL
  
  =pod
  
  =head2 _INSTANCE $object, $class
  
  The C<_INSTANCE> function is intended to be imported into your package,
  and provides a convenient way to test for an object of a particular class
  in a strictly correct manner.
  
  Returns the object itself as a convenience, or C<undef> if the value
  provided is not an object of that type.
  
  =cut
  
  eval <<'END_PERL' unless defined &_INSTANCE;
  sub _INSTANCE ($$) {
  	(Scalar::Util::blessed($_[0]) and $_[0]->isa($_[1])) ? $_[0] : undef;
  }
  END_PERL
  
  =head2 _INSTANCEDOES $object, $role
  
  This routine behaves exactly like C<L</_INSTANCE>>, but checks with C<< ->DOES
  >> rather than C<< ->isa >>.  This is probably only a good idea to use on Perl
  5.10 or later, when L<UNIVERSAL::DOES|UNIVERSAL::DOES/DOES> has been
  implemented.
  
  =cut
  
  eval <<'END_PERL' unless defined &_INSTANCEDOES;
  sub _INSTANCEDOES ($$) {
  	(Scalar::Util::blessed($_[0]) and $_[0]->DOES($_[1])) ? $_[0] : undef;
  }
  END_PERL
  
  =pod
  
  =head2 _REGEX $value
  
  The C<_REGEX> function is intended to be imported into your package,
  and provides a convenient way to test for a regular expression.
  
  Returns the value itself as a convenience, or C<undef> if the value
  provided is not a regular expression.
  
  =cut
  
  eval <<'END_PERL' unless defined &_REGEX;
  sub _REGEX ($) {
  	(defined $_[0] and 'Regexp' eq ref($_[0])) ? $_[0] : undef;
  }
  END_PERL
  
  =pod
  
  =head2 _SET \@array, $class
  
  The C<_SET> function is intended to be imported into your package,
  and provides a convenient way to test for set of at least one object of
  a particular class in a strictly correct manner.
  
  The set is provided as a reference to an C<ARRAY> of objects of the
  class provided.
  
  For an alternative function that allows zero-length sets, see the
  C<_SET0> function.
  
  Returns the C<ARRAY> reference itself as a convenience, or C<undef> if
  the value provided is not a set of that class.
  
  =cut
  
  eval <<'END_PERL' unless defined &_SET;
  sub _SET ($$) {
  	my $set = shift;
  	_ARRAY($set) or return undef;
  	foreach my $item ( @$set ) {
  		_INSTANCE($item,$_[0]) or return undef;
  	}
  	$set;
  }
  END_PERL
  
  =pod
  
  =head2 _SET0 \@array, $class
  
  The C<_SET0> function is intended to be imported into your package,
  and provides a convenient way to test for a set of objects of a
  particular class in a strictly correct manner, allowing for zero objects.
  
  The set is provided as a reference to an C<ARRAY> of objects of the
  class provided.
  
  For an alternative function that requires at least one object, see the
  C<_SET> function.
  
  Returns the C<ARRAY> reference itself as a convenience, or C<undef> if
  the value provided is not a set of that class.
  
  =cut
  
  eval <<'END_PERL' unless defined &_SET0;
  sub _SET0 ($$) {
  	my $set = shift;
  	_ARRAY0($set) or return undef;
  	foreach my $item ( @$set ) {
  		_INSTANCE($item,$_[0]) or return undef;
  	}
  	$set;
  }
  END_PERL
  
  =pod
  
  =head2 _HANDLE
  
  The C<_HANDLE> function is intended to be imported into your package,
  and provides a convenient way to test whether or not a single scalar
  value is a file handle.
  
  Unfortunately, in Perl the definition of a file handle can be a little
  bit fuzzy, so this function is likely to be somewhat imperfect (at first
  anyway).
  
  That said, it is implement as well or better than the other file handle
  detectors in existance (and we stole from the best of them).
  
  =cut
  
  # We're doing this longhand for now. Once everything is perfect,
  # we'll compress this into something that compiles more efficiently.
  # Further, testing file handles is not something that is generally
  # done millions of times, so doing it slowly is not a big speed hit.
  eval <<'END_PERL' unless defined &_HANDLE;
  sub _HANDLE {
  	my $it = shift;
  
  	# It has to be defined, of course
  	unless ( defined $it ) {
  		return undef;
  	}
  
  	# Normal globs are considered to be file handles
  	if ( ref $it eq 'GLOB' ) {
  		return $it;
  	}
  
  	# Check for a normal tied filehandle
  	# Side Note: 5.5.4's tied() and can() doesn't like getting undef
  	if ( tied($it) and tied($it)->can('TIEHANDLE') ) {
  		return $it;
  	}
  
  	# There are no other non-object handles that we support
  	unless ( Scalar::Util::blessed($it) ) {
  		return undef;
  	}
  
  	# Check for a common base classes for conventional IO::Handle object
  	if ( $it->isa('IO::Handle') ) {
  		return $it;
  	}
  
  
  	# Check for tied file handles using Tie::Handle
  	if ( $it->isa('Tie::Handle') ) {
  		return $it;
  	}
  
  	# IO::Scalar is not a proper seekable, but it is valid is a
  	# regular file handle
  	if ( $it->isa('IO::Scalar') ) {
  		return $it;
  	}
  
  	# Yet another special case for IO::String, which refuses (for now
  	# anyway) to become a subclass of IO::Handle.
  	if ( $it->isa('IO::String') ) {
  		return $it;
  	}
  
  	# This is not any sort of object we know about
  	return undef;
  }
  END_PERL
  
  =pod
  
  =head2 _DRIVER $string
  
    sub foo {
      my $class = _DRIVER(shift, 'My::Driver::Base') or die "Bad driver";
      ...
    }
  
  The C<_DRIVER> function is intended to be imported into your
  package, and provides a convenient way to load and validate
  a driver class.
  
  The most common pattern when taking a driver class as a parameter
  is to check that the name is a class (i.e. check against _CLASS)
  and then to load the class (if it exists) and then ensure that
  the class returns true for the isa method on some base driver name.
  
  Return the value as a convenience, or C<undef> if the value is not
  a class name, the module does not exist, the module does not load,
  or the class fails the isa test.
  
  =cut
  
  eval <<'END_PERL' unless defined &_DRIVER;
  sub _DRIVER ($$) {
  	(defined _CLASS($_[0]) and eval "require $_[0];" and ! $@ and $_[0]->isa($_[1]) and $_[0] ne $_[1]) ? $_[0] : undef;
  }
  END_PERL
  
  1;
  
  =pod
  
  =head1 TO DO
  
  - Add _CAN to help resolve the UNIVERSAL::can debacle
  
  - Would be even nicer if someone would demonstrate how the hell to
  build a Module::Install dist of the ::Util dual Perl/XS type. :/
  
  - Implement an assertion-like version of this module, that dies on
  error.
  
  - Implement a Test:: version of this module, for use in testing
  
  =head1 SUPPORT
  
  Bugs should be reported via the CPAN bug tracker at
  
  L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Params-Util>
  
  For other issues, contact the author.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 SEE ALSO
  
  L<Params::Validate>
  
  =head1 COPYRIGHT
  
  Copyright 2005 - 2012 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
X86_64-LINUX_PARAMS_UTIL

s/^  //mg for values %fatpacked;

my $class = 'FatPacked::'.(0+\%fatpacked);
no strict 'refs';
*{"${class}::files"} = sub { keys %{$_[0]} };

if ($] < 5.008) {
  *{"${class}::INC"} = sub {
     if (my $fat = $_[0]{$_[1]}) {
       return sub {
         return 0 unless length $fat;
         $fat =~ s/^([^\n]*\n?)//;
         $_ = $1;
         return 1;
       };
     }
     return;
  };
}

else {
  *{"${class}::INC"} = sub {
    if (my $fat = $_[0]{$_[1]}) {
      open my $fh, '<', \$fat
        or die "FatPacker error loading $_[1] (could be a perl installation issue?)";
      return $fh;
    }
    return;
  };
}

unshift @INC, bless \%fatpacked, $class;
  } # END OF FATPACK CODE

use 5.006;
use strict; use warnings;

use Perl::Tags;
use Perl::Tags::Hybrid;
use Perl::Tags::PPI;
use Perl::Tags::Naive::Moose; # includes ::Naive

# it is intended to be able to `require` this file, to be called
# simply from an Editor, and to be fatpackable

1;
