Fatpacked Data Printer

dataprinterfatpack.pl

#!/usr/bin/perl

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

$fatpacked{"Clone/PP.pm"} = <<'CLONE_PP';
  package Clone::PP;
  
  use strict;
  use vars qw($VERSION @EXPORT_OK);
  use Exporter;
  
  $VERSION = 1.02;
  
  @EXPORT_OK = qw( clone );
  sub import { goto &Exporter::import } # lazy Exporter
  
  # These methods can be temporarily overriden to work with a given class.
  use vars qw( $CloneSelfMethod $CloneInitMethod );
  $CloneSelfMethod ||= 'clone_self';
  $CloneInitMethod ||= 'clone_init';
  
  # Used to detect looped networks and avoid infinite recursion. 
  use vars qw( %CloneCache );
  
  # Generic cloning function
  sub clone {
    my $source = shift;
    
    # Optional depth limit: after a given number of levels, do shallow copy.
    my $depth = shift;
    return $source if ( defined $depth and $depth -- < 1 );
    
    # Maintain a shared cache during recursive calls, then clear it at the end.
    local %CloneCache = ( undef => undef ) unless ( exists $CloneCache{undef} );
    
    return $CloneCache{ $source } if ( exists $CloneCache{ $source } );
    
    # Non-reference values are copied shallowly
    my $ref_type = ref $source or return $source;
    
    # Extract both the structure type and the class name of referent
    my $class_name;
    if ( "$source" =~ /^\Q$ref_type\E\=([A-Z]+)\(0x[0-9a-f]+\)$/ ) {
      $class_name = $ref_type;
      $ref_type = $1;
      # Some objects would prefer to clone themselves; check for clone_self().
      return $CloneCache{ $source } = $source->$CloneSelfMethod() 
  				  if $source->can($CloneSelfMethod);
    }
    
    # To make a copy:
    # - Prepare a reference to the same type of structure;
    # - Store it in the cache, to avoid looping it it refers to itself;
    # - Tie in to the same class as the original, if it was tied;
    # - Assign a value to the reference by cloning each item in the original;
    
    my $copy;
    if ($ref_type eq 'HASH') {
      $CloneCache{ $source } = $copy = {};
      if ( my $tied = tied( %$source ) ) { tie %$copy, ref $tied }
      %$copy = map { ! ref($_) ? $_ : clone($_, $depth) } %$source;
    } elsif ($ref_type eq 'ARRAY') {
      $CloneCache{ $source } = $copy = [];
      if ( my $tied = tied( @$source ) ) { tie @$copy, ref $tied }
      @$copy = map { ! ref($_) ? $_ : clone($_, $depth) } @$source;
    } elsif ($ref_type eq 'REF' or $ref_type eq 'SCALAR') {
      $CloneCache{ $source } = $copy = \( my $var = "" );
      if ( my $tied = tied( $$source ) ) { tie $$copy, ref $tied }
      $$copy = clone($$source, $depth);
    } else {
      # Shallow copy anything else; this handles a reference to code, glob, regex
      $CloneCache{ $source } = $copy = $source;
    }
    
    # - Bless it into the same class as the original, if it was blessed;
    # - If it has a post-cloning initialization method, call it.
    if ( $class_name ) {
      bless $copy, $class_name;
      $copy->$CloneInitMethod() if $copy->can($CloneInitMethod);
    }
    
    return $copy;
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  Clone::PP - Recursively copy Perl datatypes
  
  =head1 SYNOPSIS
  
    use Clone::PP qw(clone);
    
    $item = { 'foo' => 'bar', 'move' => [ 'zig', 'zag' ]  };
    $copy = clone( $item );
  
    $item = [ 'alpha', 'beta', { 'gamma' => 'vlissides' } ];
    $copy = clone( $item );
  
    $item = Foo->new();
    $copy = clone( $item );
  
  Or as an object method:
  
    require Clone::PP;
    push @Foo::ISA, 'Clone::PP';
    
    $item = Foo->new();
    $copy = $item->clone();
  
  =head1 DESCRIPTION
  
  This module provides a general-purpose clone function to make deep
  copies of Perl data structures. It calls itself recursively to copy
  nested hash, array, scalar and reference types, including tied
  variables and objects.
  
  The clone() function takes a scalar argument to copy. To duplicate
  arrays or hashes, pass them in by reference:
  
    my $copy = clone(\@array);    my @copy = @{ clone(\@array) };
    my $copy = clone(\%hash);     my %copy = %{ clone(\%hash) };
  
  The clone() function also accepts an optional second parameter that
  can be used to limit the depth of the copy. If you pass a limit of
  0, clone will return the same value you supplied; for a limit of
  1, a shallow copy is constructed; for a limit of 2, two layers of
  copying are done, and so on.
  
    my $shallow_copy = clone( $item, 1 );
  
  To allow objects to intervene in the way they are copied, the
  clone() function checks for a couple of optional methods. If an
  object provides a method named C<clone_self>, it is called and the
  result returned without further processing. Alternately, if an
  object provides a method named C<clone_init>, it is called on the
  copied object before it is returned.
  
  =head1 BUGS
  
  Some data types, such as globs, regexes, and code refs, are always copied shallowly.
  
  References to hash elements are not properly duplicated. (This is why two tests in t/dclone.t that are marked "todo".) For example, the following test should succeed but does not:
  
    my $hash = { foo => 1 }; 
    $hash->{bar} = \{ $hash->{foo} }; 
    my $copy = clone( \%hash ); 
    $hash->{foo} = 2; 
    $copy->{foo} = 2; 
    ok( $hash->{bar} == $copy->{bar} );
  
  To report bugs via the CPAN web tracking system, go to 
  C<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Clone-PP> or send mail 
  to C<Dist=Clone-PP#rt.cpan.org>, replacing C<#> with C<@>.
  
  =head1 SEE ALSO
  
  For a faster implementation in XS, see L<Clone/clone>, L<Util/clone>, or <Storable/dclone>.
  
  =head1 CREDITS AND COPYRIGHT
  
  Developed by Matthew Simon Cavalletto at Evolution Softworks. 
  More free Perl software is available at C<www.evoscript.org>.
  
  Copyright 2003 Matthew Simon Cavalletto. You may contact the author
  directly at C<evo@cpan.org> or C<simonm@cavalletto.org>.
  
  Code initially derived from Ref.pm. Portions Copyright 1994 David Muir Sharnoff.
  
  Interface based by Clone by Ray Finch with contributions from chocolateboy.
  Portions Copyright 2001 Ray Finch. Portions Copyright 2001 chocolateboy. 
  
  You may use, modify, and distribute this software under the same terms as Perl.
  
  =cut
CLONE_PP

$fatpacked{"DDP.pm"} = <<'DDP';
  package DDP;
  use strict;
  use warnings;
  use Data::Printer;
  
  BEGIN {
      push our @ISA, 'Data::Printer';
      our $VERSION = $Data::Printer::VERSION;
  }
  1;
  __END__
  
  =head1 NAME
  
  DDP - Data::Printer shortcut for faster debugging
  
  =head1 SYNOPSIS
  
    use DDP; p $my_data;
  
  =head1 DESCRIPTION
  
  Tired of typing C<use Data::Printer> every time? C<DDP> lets you quickly call
  your favorite variable dumper!
  
  It behaves exacly like L<Data::Printer> - it is, indeed, just an alias to it :)
  
  Happy debugging!
  
  =head1 SEE ALSO
  
  L<Data::Printer>
  
DDP

$fatpacked{"Data/Printer.pm"} = <<'DATA_PRINTER';
  package Data::Printer;
  use strict;
  use warnings;
  use Term::ANSIColor qw(color colored);
  use Scalar::Util;
  use Sort::Naturally;
  use Carp qw(croak);
  use Clone::PP qw(clone);
  use if $] >= 5.010, 'Hash::Util::FieldHash' => qw(fieldhash);
  use if $] < 5.010, 'Hash::Util::FieldHash::Compat' => qw(fieldhash);
  use File::Spec;
  use File::HomeDir ();
  use Fcntl;
  use version 0.77 ();
  
  our $VERSION = '0.35';
  
  BEGIN {
      if ($^O =~ /Win32/i) {
          require Win32::Console::ANSI;
          Win32::Console::ANSI->import;
      }
  }
  
  
  # defaults
  my $BREAK = "\n";
  my $properties = {
      'name'           => 'var',
      'indent'         => 4,
      'index'          => 1,
      'max_depth'      => 0,
      'multiline'      => 1,
      'sort_keys'      => 1,
      'deparse'        => 0,
      'hash_separator' => '   ',
      'separator'      => ',',
      'end_separator'  => 0,
      'show_tied'      => 1,
      'show_tainted'   => 1,
      'show_weak'      => 1,
      'show_readonly'  => 0,
      'show_lvalue'    => 1,
      'print_escapes'  => 0,
      'escape_chars'   => 'none',
      'quote_keys'     => 'auto',
      'use_prototypes' => 1,
      'output'         => 'stderr',
      'return_value'   => 'dump',       # also 'void' or 'pass'
      'colored'        => 'auto',       # also 0 or 1
      'caller_info'    => 0,
      'caller_message' => 'Printing in line __LINE__ of __FILENAME__:',
      'class_method'   => '_data_printer', # use a specific dump method, if available
      'color'          => {
          'array'       => 'bright_white',
          'number'      => 'bright_blue',
          'string'      => 'bright_yellow',
          'class'       => 'bright_green',
          'method'      => 'bright_green',
          'undef'       => 'bright_red',
          'hash'        => 'magenta',
          'regex'       => 'yellow',
          'code'        => 'green',
          'glob'        => 'bright_cyan',
          'vstring'     => 'bright_blue',
          'lvalue'      => 'bright_white',
          'format'      => 'bright_cyan',
          'repeated'    => 'white on_red',
          'caller_info' => 'bright_cyan',
          'weak'        => 'cyan',
          'tainted'     => 'red',
          'escaped'     => 'bright_red',
          'unknown'     => 'bright_yellow on_blue',
      },
      'class' => {
          inherited    => 'none',   # also 'all', 'public' or 'private'
          universal    => 1,
          parents      => 1,
          linear_isa   => 'auto',
          expand       => 1,        # how many levels to expand. 0 for none, 'all' for all
          internals    => 1,
          export       => 1,
          sort_methods => 1,
          show_methods => 'all',    # also 'none', 'public', 'private'
          show_reftype => 0,
          _depth       => 0,        # used internally
      },
      'filters' => {
          # The IO ref type isn't supported as you can't actually create one,
          # any handle you make is automatically blessed into an IO::* object,
          # and those are separately handled.
          SCALAR  => [ \&SCALAR   ],
          ARRAY   => [ \&ARRAY    ],
          HASH    => [ \&HASH     ],
          REF     => [ \&REF      ],
          CODE    => [ \&CODE     ],
          GLOB    => [ \&GLOB     ],
          VSTRING => [ \&VSTRING  ],
          LVALUE  => [ \&LVALUE ],
          FORMAT  => [ \&FORMAT ],
          Regexp  => [ \&Regexp   ],
          -unknown=> [ \&_unknown ],
          -class  => [ \&_class   ],
      },
  
      _output          => *STDERR,     # used internally
      _current_indent  => 0,           # used internally
      _linebreak       => \$BREAK,     # used internally
      _seen            => {},          # used internally
      _seen_override   => {},          # used internally
      _depth           => 0,           # used internally
      _tie             => 0,           # used internally
  };
  
  
  sub import {
      my $class = shift;
      my $args;
      if (scalar @_) {
          $args = @_ == 1 ? shift : {@_};
          croak 'Data::Printer can receive either a hash or a hash reference.'
              unless ref $args and ref $args eq 'HASH';
      }
  
      # the RC file overrides the defaults,
      # (and we load it only once)
      unless( exists $properties->{_initialized} ) {
          _load_rc_file($args);
          $properties->{_initialized} = 1;
      }
  
      # and 'use' arguments override the RC file
      if ($args) {
          $properties = _merge( $args );
      }
  
      my $exported = ($properties->{use_prototypes} ? \&p : \&np );
      my $imported = $properties->{alias} || 'p';
      my $caller = caller;
      no strict 'refs';
      *{"$caller\::$imported"} = $exported;
  }
  
  
  sub p (\[@$%&];%) {
      return _print_and_return( $_[0], _data_printer(!!defined wantarray, @_) );
  }
  
  # np() is a p() clone without prototypes.
  # Just like regular Data::Dumper, this version
  # expects a reference as its first argument.
  # We make a single exception for when we only
  # get one argument, in which case we ref it
  # for the user and keep going.
  sub np  {
      my $item = shift;
  
      if (!ref $item && @_ == 0) {
          my $item_value = $item;
          $item = \$item_value;
      }
  
      return _print_and_return( $item, _data_printer(!!defined wantarray, $item, @_) );
  }
  
  sub _print_and_return {
      my ($item, $dump, $p) = @_;
  
      if ( $p->{return_value} eq 'pass' ) {
          print { $p->{_output} } $dump . $/;
  
          my $ref = ref $item;
          if ($ref eq 'ARRAY') {
              return @{ $item };
          }
          elsif ($ref eq 'HASH') {
              return %{ $item };
          }
          elsif ( grep { $ref eq $_ } qw(REF SCALAR CODE Regexp GLOB VSTRING) ) {
              return $$item;
          }
          else {
              return $item;
          }
      }
      elsif ( $p->{return_value} eq 'void' ) {
          print { $p->{_output} } $dump . $/;
          return;
      }
      else {
          print { $p->{_output} } $dump . $/ unless defined wantarray;
          return $dump;
      }
  }
  
  sub _data_printer {
      my $wantarray = shift;
  
      croak 'When calling p() without prototypes, please pass arguments as references'
          unless ref $_[0];
  
      my ($item, %local_properties) = @_;
      local %ENV = %ENV;
  
      my $p = _merge(\%local_properties);
      unless ($p->{multiline}) {
          $BREAK = ' ';
          $p->{'indent'} = 0;
          $p->{'index'}  = 0;
      }
  
      # We disable colors if colored is set to false.
      # If set to "auto", we disable colors if the user
      # set ANSI_COLORS_DISABLED or if we're either
      # returning the value (instead of printing) or
      # being piped to another command.
      if ( !$p->{colored}
            or ($p->{colored} eq 'auto'
                and (exists $ENV{ANSI_COLORS_DISABLED}
                     or $wantarray
                     or not -t $p->{_output}
                    )
            )
      ) {
          $ENV{ANSI_COLORS_DISABLED} = 1;
      }
      else {
          delete $ENV{ANSI_COLORS_DISABLED};
      }
  
      my $out = color('reset');
  
      if ( $p->{caller_info} and $p->{_depth} == 0 ) {
          $out .= _get_info_message($p);
      }
  
      $out .= _p( $item, $p );
      return ($out, $p);
  }
  
  
  sub _p {
      my ($item, $p) = @_;
      my $ref = (defined $p->{_reftype} ? $p->{_reftype} : ref $item);
      my $tie;
  
      my $string = '';
  
      # Object's unique ID, avoiding circular structures
      my $id = _object_id( $item );
      if ( exists $p->{_seen}->{$id} ) {
          if ( not defined $p->{_reftype} ) {
              return colored($p->{_seen}->{$id}, $p->{color}->{repeated});
          }
      }
      # some filters don't want us to show their repeated refs
      elsif( !exists $p->{_seen_override}{$ref} ) {
          $p->{_seen}->{$id} = $p->{name};
      }
  
      delete $p->{_reftype}; # abort override
  
      # globs don't play nice
      $ref = 'GLOB' if "$item" =~ /GLOB\([^()]+\)$/;
  
  
      # filter item (if user set a filter for it)
      my $found;
      if ( exists $p->{filters}->{$ref} ) {
          foreach my $filter ( @{ $p->{filters}->{$ref} } ) {
              if ( defined (my $result = $filter->($item, $p)) ) {
                  $string .= $result;
                  $found = 1;
                  last;
              }
          }
      }
  
      if (not $found and Scalar::Util::blessed($item) ) {
          # let '-class' filters have a go
          foreach my $filter ( @{ $p->{filters}->{'-class'} } ) {
              if ( defined (my $result = $filter->($item, $p)) ) {
                  $string .= $result;
                  $found = 1;
                  last;
              }
          }
      }
      
      if ( not $found ) {
          # if it's not a class and not a known core type, we must be in
          # a future perl with some type we're unaware of
          foreach my $filter ( @{ $p->{filters}->{'-unknown'} } ) {
              if ( defined (my $result = $filter->($item, $p)) ) {
                  $string .= $result;
                  last;
              }
          }
      }
  
      if ($p->{show_tied} and $p->{_tie} ) {
          $string .= ' (tied to ' . $p->{_tie} . ')';
          $p->{_tie} = '';
      }
  
      return $string;
  }
  
  
  
  ######################################
  ## Default filters
  ######################################
  
  sub SCALAR {
      my ($item, $p) = @_;
      my $string = '';
  
      if (not defined $$item) {
          $string .= colored('undef', $p->{color}->{'undef'});
      }
      elsif (Scalar::Util::looks_like_number($$item)) {
          $string .= colored($$item, $p->{color}->{'number'});
      }
      else {
          my $val = _escape_chars($$item, $p->{color}{string}, $p);
  
          $string .= q["] . colored($val, $p->{color}->{'string'}) . q["];
      }
  
      $string .= ' ' . colored('(TAINTED)', $p->{color}->{'tainted'})
          if $p->{show_tainted} and Scalar::Util::tainted($$item);
  
      $p->{_tie} = ref tied $$item;
  
      if ($p->{show_readonly} and &Internals::SvREADONLY( $item )) {
          $string .= ' (read-only)';
      }
  
      return $string;
  }
  
  sub _escape_chars {
      my ($str, $orig_color, $p) = @_;
  
      $orig_color   = color( $orig_color );
      my $esc_color = color( $p->{color}{escaped} );
  
      # if we're escaping everything then we don't need to keep swapping
      # colors in and out, and we need to return right away because
      # we no longer need to print_escapes
      if ($p->{escape_chars} eq "all") {
          return $esc_color
                 . join('',map { sprintf '\x{%02x}', ord $_ } split //, $str)
                 . $orig_color
      }
  
      $str =~ s/\e/$esc_color\\e$orig_color/g if $p->{print_escapes};
  
      if ($p->{escape_chars} eq "nonascii") {
          $str =~ s<([^\x{00}-\x{7f}]+)><
            $esc_color
            . (join "", map { sprintf '\x{%02x}', ord $_ } split //, $1)
            . $orig_color
          >ge;
      } elsif ($p->{escape_chars} eq "nonlatin1") {
          $str =~ s<([^\x{00}-\x{ff}]+)><
            $esc_color
            . (join "", map { sprintf '\x{%02x}', ord $_ } split //, $1) . $orig_color
          >ge;
      }
  
      if ($p->{print_escapes}) {
          my %escaped = (
              "\n" => '\n',
              "\r" => '\r',
              "\t" => '\t',
              "\f" => '\f',
              "\b" => '\b',
              "\a" => '\a',
          );
          foreach my $k ( keys %escaped ) {
              $str =~ s/$k/$esc_color$escaped{$k}$orig_color/g;
          }
      }
      # always escape the null character
      $str =~ s/\0/$esc_color\\0$orig_color/g;
  
      return $str;
  }
  
  
  sub ARRAY {
      my ($item, $p) = @_;
      my $string = '';
      $p->{_depth}++;
  
      if ( $p->{max_depth} and $p->{_depth} > $p->{max_depth} ) {
          $string .= '[ ... ]';
      }
      elsif (not @$item) {
          $string .= '[]';
      }
      else {
          $string .= "[$BREAK";
          $p->{_current_indent} += $p->{indent};
  
          foreach my $i (0 .. $#{$item} ) {
              $p->{name} .= "[$i]";
  
              my $array_elem = $item->[$i];
              $string .= (' ' x $p->{_current_indent});
              if ($p->{'index'}) {
                  $string .= colored(
                               sprintf("%-*s", 3 + length($#{$item}), "[$i]"),
                               $p->{color}->{'array'}
                         );
              }
  
              my $ref = ref $array_elem;
  
              # scalar references should be re-referenced
              # to gain a '\' sign in front of them
              if (!$ref or $ref eq 'SCALAR') {
                  $string .= _p( \$array_elem, $p );
              }
              else {
                  $string .= _p( $array_elem, $p );
              }
              $string .= ' ' . colored('(weak)', $p->{color}->{'weak'})
                  if $ref and Scalar::Util::isweak($item->[$i]) and $p->{show_weak};
  
              $string .= $p->{separator}
                if $i < $#{$item} || $p->{end_separator};
  
              $string .= $BREAK;
  
              my $size = 2 + length($i); # [10], [100], etc
              substr $p->{name}, -$size, $size, '';
          }
          $p->{_current_indent} -= $p->{indent};
          $string .= (' ' x $p->{_current_indent}) . "]";
      }
  
      $p->{_tie} = ref tied @$item;
      $p->{_depth}--;
  
      return $string;
  }
  
  
  sub REF {
      my ($item, $p) = @_;
      my $string = '';
  
      # look-ahead, add a '\' only if it's not an object
      if (my $ref_ahead = ref $$item ) {
          $string .= '\\ ' if grep { $_ eq $ref_ahead }
              qw(SCALAR CODE Regexp ARRAY HASH GLOB REF);
      }
      $string .= _p($$item, $p);
  
      $string .= ' ' . colored('(weak)', $p->{color}->{'weak'})
          if Scalar::Util::isweak($$item) and $p->{show_weak};
  
      return $string;
  }
  
  
  sub CODE {
      my ($item, $p) = @_;
      my $string = '';
  
      my $code = 'sub { ... }';
      if ($p->{deparse}) {
          $code = _deparse( $item, $p );
      }
      $string .= colored($code, $p->{color}->{'code'});
      return $string;
  }
  
  
  sub HASH {
      my ($item, $p) = @_;
      my $string = '';
  
      $p->{_depth}++;
  
      if ( $p->{max_depth} and $p->{_depth} > $p->{max_depth} ) {
          $string .= '{ ... }';
      }
      elsif (not keys %$item) {
          $string .= '{}';
      }
      else {
          $string .= "{$BREAK";
          $p->{_current_indent} += $p->{indent};
  
          my $total_keys  = scalar keys %$item;
          my $len         = 0;
          my $multiline   = $p->{multiline};
          my $hash_color  = $p->{color}{hash};
          my $quote_keys  = $p->{quote_keys};
  
          my @keys = ();
  
          # first pass, preparing keys to display (and getting largest key size)
          foreach my $key ($p->{sort_keys} ? nsort keys %$item : keys %$item ) {
              my $new_key = _escape_chars($key, $hash_color, $p);
              my $colored = colored( $new_key, $hash_color );
  
              # wrap in uncolored single quotes if there's
              # any space or escaped characters
              if ( $quote_keys
                    and (
                          $quote_keys ne 'auto'
                          or (
                               $key eq q()
                               or $new_key ne $key
                               or $new_key =~ /\s|\n|\t|\r/
                          )
                    )
              ) {
                  $colored = qq['$colored'];
              }
  
              push @keys, {
                  raw     => $key,
                  colored => $colored,
              };
  
              # length of the largest key is used for indenting
              if ($multiline) {
                  my $l = length $colored;
                  $len = $l if $l > $len;
              }
          }
  
          # second pass, traversing and rendering
          foreach my $key (@keys) {
              my $raw_key     = $key->{raw};
              my $colored_key = $key->{colored};
              my $element     = $item->{$raw_key};
              $p->{name}     .= "{$raw_key}";
  
              $string .= (' ' x $p->{_current_indent})
                       . sprintf("%-*s", $len, $colored_key)
                       . $p->{hash_separator}
                       ;
  
              my $ref = ref $element;
              # scalar references should be re-referenced
              # to gain a '\' sign in front of them
              if (!$ref or $ref eq 'SCALAR') {
                  $string .= _p( \$element, $p );
              }
              else {
                  $string .= _p( $element, $p );
              }
  
              $string .= ' ' . colored('(weak)', $p->{color}->{'weak'})
                  if $ref
                    and $p->{show_weak}
                    and Scalar::Util::isweak($item->{$raw_key});
  
              $string .= $p->{separator}
                if --$total_keys > 0 || $p->{end_separator};
  
              $string .= $BREAK;
  
              my $size = 2 + length($raw_key); # {foo}, {z}, etc
              substr $p->{name}, -$size, $size, '';
          }
          $p->{_current_indent} -= $p->{indent};
          $string .= (' ' x $p->{_current_indent}) . "}";
      }
  
      $p->{_tie} = ref tied %$item;
      $p->{_depth}--;
  
      return $string;
  }
  
  
  sub Regexp {
      my ($item, $p) = @_;
      my $string = '';
  
      my $val = "$item";
      # a regex to parse a regex. Talk about full circle :)
      # note: we are not validating anything, just grabbing modifiers
      if ($val =~ m/\(\?\^?([uladxismpogce]*)(?:\-[uladxismpogce]+)?:(.*)\)/s) {
          my ($modifiers, $val) = ($1, $2);
          $string .= colored($val, $p->{color}->{'regex'});
          if ($modifiers) {
              $string .= "  (modifiers: $modifiers)";
          }
      }
      else {
          croak "Unrecognized regex $val. Please submit a bug report for Data::Printer.";
      }
      return $string;
  }
  
  sub VSTRING {
      my ($item, $p) = @_;
      my $string = '';
      $string .= colored(version->declare($$item)->normal, $p->{color}->{'vstring'});
      return $string;
  }
  
  sub FORMAT {
      my ($item, $p) = @_;
      my $string = '';
      $string .= colored("FORMAT", $p->{color}->{'format'});
      return $string;
  }
  
  sub LVALUE {
      my ($item, $p) = @_;
      my $string = SCALAR( $item, $p );
      $string .= colored( ' (LVALUE)', $p->{color}{lvalue} )
          if $p->{show_lvalue};
  
      return $string;
  }
  
  sub GLOB {
      my ($item, $p) = @_;
      my $string = '';
  
      $string .= colored("$$item", $p->{color}->{'glob'});
  
      my $extra = '';
  
      # unfortunately, some systems (like Win32) do not
      # implement some of these flags (maybe not even
      # fcntl() itself, so we must wrap it.
      my $flags;
      eval { no warnings qw( unopened closed ); $flags = fcntl($$item, F_GETFL, 0) };
      if ($flags) {
          $extra .= ($flags & O_WRONLY) ? 'write-only'
                  : ($flags & O_RDWR)   ? 'read/write'
                  : 'read-only'
                  ;
  
          # How to avoid croaking when the system
          # doesn't implement one of those, without skipping
          # the whole thing? Maybe there's a better way.
          # Solaris, for example, doesn't have O_ASYNC :(
          my %flags = ();
          eval { $flags{'append'}      = O_APPEND   };
          eval { $flags{'async'}       = O_ASYNC    }; # leont says this is the only one I should care for.
          eval { $flags{'create'}      = O_CREAT    };
          eval { $flags{'truncate'}    = O_TRUNC    };
          eval { $flags{'nonblocking'} = O_NONBLOCK };
  
          if (my @flags = grep { $flags & $flags{$_} } keys %flags) {
              $extra .= ", flags: @flags";
          }
          $extra .= ', ';
      }
      my @layers = ();
      eval { @layers = PerlIO::get_layers $$item }; # TODO: try PerlIO::Layers::get_layers (leont)
      unless ($@) {
          $extra .= "layers: @layers";
      }
      $string .= "  ($extra)" if $extra;
  
      $p->{_tie} = ref tied *$$item;
      return $string;
  }
  
  
  sub _unknown {
      my($item, $p) = @_;
      my $ref = ref $item;
      
      my $string = '';
      $string = colored($ref, $p->{color}->{'unknown'});
      return $string;
  }
  
  sub _class {
      my ($item, $p) = @_;
      my $ref = ref $item;
  
      # if the user specified a method to use instead, we do that
      if ( $p->{class_method} and my $method = $item->can($p->{class_method}) ) {
          return $method->($item, $p);
      }
  
      my $string = '';
      $p->{class}{_depth}++;
  
      $string .= colored($ref, $p->{color}->{'class'});
  
      if ( $p->{class}{show_reftype} ) {
          $string .= ' (' . colored(
              Scalar::Util::reftype($item),
              $p->{color}->{'class'}
          ) . ')';
      }
  
      if ($p->{class}{expand} eq 'all'
          or $p->{class}{expand} >= $p->{class}{_depth}
      ) {
          $string .= "  {$BREAK";
  
          $p->{_current_indent} += $p->{indent};
  
          if ($] >= 5.010) {
              require mro;
          } else {
              require MRO::Compat;
          }
          require Package::Stash;
  
          my $stash = Package::Stash->new($ref);
  
          if ( my @superclasses = @{$stash->get_symbol('@ISA')||[]} ) {
              if ($p->{class}{parents}) {
                  $string .= (' ' x $p->{_current_indent})
                          . 'Parents       '
                          . join(', ', map { colored($_, $p->{color}->{'class'}) }
                                       @superclasses
                          ) . $BREAK;
              }
  
              if ( $p->{class}{linear_isa} and
                    (
                      ($p->{class}{linear_isa} eq 'auto' and @superclasses > 1)
                      or
                      ($p->{class}{linear_isa} ne 'auto')
                    )
              ) {
                  $string .= (' ' x $p->{_current_indent})
                          . 'Linear @ISA   '
                          . join(', ', map { colored( $_, $p->{color}->{'class'}) }
                                    @{mro::get_linear_isa($ref)}
                          ) . $BREAK;
              }
          }
  
          $string .= _show_methods($ref, $p)
              if $p->{class}{show_methods} and $p->{class}{show_methods} ne 'none';
  
          if ( $p->{'class'}->{'internals'} ) {
              $string .= (' ' x $p->{_current_indent})
                      . 'internals: ';
  
              local $p->{_reftype} = Scalar::Util::reftype $item;
              $string .= _p($item, $p);
              $string .= $BREAK;
          }
  
          $p->{_current_indent} -= $p->{indent};
          $string .= (' ' x $p->{_current_indent}) . "}";
      }
      $p->{class}{_depth}--;
  
      return $string;
  }
  
  
  
  ######################################
  ## Auxiliary (internal) subs
  ######################################
  
  # All glory to Vincent Pit for coming up with this implementation,
  # to Goro Fuji for Hash::FieldHash, and of course to Michael Schwern
  # and his "Object::ID", whose code is copied almost verbatim below.
  {
      fieldhash my %IDs;
  
      my $Last_ID = "a";
      sub _object_id {
          my $self = shift;
  
          # This is 15% faster than ||=
          return $IDs{$self} if exists $IDs{$self};
          return $IDs{$self} = ++$Last_ID;
      }
  }
  
  
  sub _show_methods {
      my ($ref, $p) = @_;
  
      my $string = '';
      my $methods = {
          public => [],
          private => [],
      };
      my $inherited = $p->{class}{inherited} || 'none';
  
      require B;
  
      my $methods_of = sub {
          my ($name) = @_;
          map {
              my $m;
              if ($_
                  and $m = B::svref_2object($_)
                  and $m->isa('B::CV')
                  and not $m->GV->isa('B::Special')
              ) {
                  [ $m->GV->STASH->NAME, $m->GV->NAME ]
              } else {
                  ()
              }
          } values %{Package::Stash->new($name)->get_all_symbols('CODE')}
      };
  
      my %seen_method_name;
  
  METHOD:
      foreach my $method (
          map $methods_of->($_), @{mro::get_linear_isa($ref)},
                                 $p->{class}{universal} ? 'UNIVERSAL' : ()
      ) {
          my ($package_string, $method_string) = @$method;
  
          next METHOD if $seen_method_name{$method_string}++;
  
          my $type = substr($method_string, 0, 1) eq '_' ? 'private' : 'public';
  
          if ($package_string ne $ref) {
              next METHOD unless $inherited ne 'none'
                             and ($inherited eq 'all' or $type eq $inherited);
              $method_string .= ' (' . $package_string . ')';
          }
  
          push @{ $methods->{$type} }, $method_string;
      }
  
      # render our string doing a natural sort by method name
      my $show_methods = $p->{class}{show_methods};
      foreach my $type (qw(public private)) {
          next unless $show_methods eq 'all'
                   or $show_methods eq $type;
  
          my @list = ($p->{class}{sort_methods} ? nsort @{$methods->{$type}} : @{$methods->{$type}});
  
          $string .= (' ' x $p->{_current_indent})
                   . "$type methods (" . scalar @list . ')'
                   . (@list ? ' : ' : '')
                   . join(', ', map { colored($_, $p->{color}->{method}) }
                                @list
                     ) . $BREAK;
      }
  
      return $string;
  }
  
  sub _deparse {
      my ($item, $p) = @_;
      require B::Deparse;
      my $i = $p->{indent};
      my $deparseopts = ["-sCi${i}v'Useless const omitted'"];
  
      my $sub = 'sub ' . B::Deparse->new($deparseopts)->coderef2text($item);
      my $pad = "\n" . (' ' x ($p->{_current_indent} + $i));
      $sub    =~ s/\n/$pad/gse;
      return $sub;
  }
  
  sub _get_info_message {
      my $p = shift;
      my @caller = caller 2;
  
      my $message = $p->{caller_message};
  
      $message =~ s/\b__PACKAGE__\b/$caller[0]/g;
      $message =~ s/\b__FILENAME__\b/$caller[1]/g;
      $message =~ s/\b__LINE__\b/$caller[2]/g;
  
      return colored($message, $p->{color}{caller_info}) . $BREAK;
  }
  
  
  sub _merge {
      my $p = shift;
      my $clone = clone $properties;
  
      if ($p) {
          foreach my $key (keys %$p) {
              if ($key eq 'color' or $key eq 'colour') {
                  my $color = $p->{$key};
                  if ( not ref $color or ref $color ne 'HASH' ) {
                      Carp::carp q['color' should be a HASH reference. Did you mean 'colored'?];
                      $clone->{color} = {};
                  }
                  else {
                      foreach my $target ( keys %$color ) {
                          $clone->{color}->{$target} = $p->{$key}->{$target};
                      }
                  }
              }
              elsif ($key eq 'class') {
                  foreach my $item ( keys %{$p->{class}} ) {
                      $clone->{class}->{$item} = $p->{class}->{$item};
                  }
              }
              elsif ($key eq 'filters') {
                  my $val = $p->{$key};
  
                  foreach my $item (keys %$val) {
                      my $filters = $val->{$item};
  
                      # EXPERIMENTAL: filters in modules
                      if ($item eq '-external') {
                          my @external = ( ref($filters) ? @$filters : ($filters) );
  
                          foreach my $class ( @external ) {
                              my $module = "Data::Printer::Filter::$class";
                              eval "use $module";
                              if ($@) {
                                  warn "Error loading filter '$module': $@";
                              }
                              else {
                                  my %from_module = %{$module->_filter_list};
                                  my %extras      = %{$module->_extra_options};
  
                                  foreach my $k (keys %from_module) {
                                      unshift @{ $clone->{filters}->{$k} }, @{ $from_module{$k} };
                                      $clone->{_seen_override}{$k} = 1
                                          if $extras{$k}{show_repeated};
                                  }
                              }
                          }
                      }
                      else {
                          my @filter_list = ( ref $filters eq 'CODE' ? ( $filters ) : @$filters );
                          unshift @{ $clone->{filters}->{$item} }, @filter_list;
                      }
                  }
              }
              elsif ($key eq 'output') {
                  my $out = $p->{output};
                  my $ref = ref $out;
  
                  $clone->{output} = $out;
  
                  my %output_target = (
                       stdout => *STDOUT,
                       stderr => *STDERR,
                  );
  
                  my $error;
                  if (!$ref and exists $output_target{ lc $out }) {
                      $clone->{_output} = $output_target{ lc $out };
                  }
                  elsif ( ( $ref and $ref eq 'GLOB')
                       or (!$ref and \$out =~ /GLOB\([^()]+\)$/)
                  ) {
                      $clone->{_output} = $out;
                  }
                  elsif ( !$ref or $ref eq 'SCALAR' ) {
                      if( open my $fh, '>>', $out ) {
                          $clone->{_output} = $fh;
                      }
                      else {
                          $error = 1;
                      }
                  }
                  else {
                      $error = 1;
                  }
  
                  if ($error) {
                      Carp::carp 'Error opening custom output handle.';
                      $clone->{_output} = $output_target{ 'stderr' };
                  }
              }
              else {
                  $clone->{$key} = $p->{$key};
              }
          }
      }
  
      return $clone;
  }
  
  
  sub _load_rc_file {
      my $args = shift || {};
  
      my $file = exists $args->{rc_file}    ? $args->{rc_file}
               : exists $ENV{DATAPRINTERRC} ? $ENV{DATAPRINTERRC}
               : File::Spec->catfile(File::HomeDir->my_home,'.dataprinter');
  
      return unless -e $file;
  
      my $mode = (stat $file )[2];
      if ($^O !~ /Win32/i && ($mode & 0020 || $mode & 0002) ) {
          warn "rc file '$file' must NOT be writeable to other users. Skipping.\n";
          return;
      }
  
      if ( -l $file || (!-f _) || -p _ || -S _ || -b _ || -c _ ) {
          warn "rc file '$file' doesn't look like a plain file. Skipping.\n";
          return;
      }
  
      unless (-o $file) {
          warn "rc file '$file' must be owned by your (effective) user. Skipping.\n";
          return;
      }
  
      if ( open my $fh, '<', $file ) {
          my $rc_data;
          { local $/; $rc_data = <$fh> }
          close $fh;
  
          if( ${^TAINT} != 0 ) {
              if ( $args->{allow_tainted} ) {
                  warn "WARNING: Reading tainted file '$file' due to user override.\n";
                  $rc_data =~ /(.+)/s; # very bad idea - god help you
                  $rc_data = $1;
              }
              else {
                  warn "taint mode on: skipping rc file '$file'.\n";
                  return;
              }
          }
  
          my $config = eval $rc_data;
          if ( $@ ) {
              warn "Error loading $file: $@\n";
          }
          elsif (!ref $config or ref $config ne 'HASH') {
              warn "Error loading $file: config file must return a hash reference\n";
          }
          else {
              $properties = _merge( $config );
          }
      }
      else {
          warn "error opening '$file': $!\n";
      }
  }
  
  
  1;
  __END__
  
  =encoding utf8
  
  =head1 NAME
  
  Data::Printer - colored pretty-print of Perl data structures and objects
  
  =head1 SYNOPSIS
  
  Want to see what's inside a variable in a complete, colored
  and human-friendly way?
  
    use Data::Printer;   # or just "use DDP" for short
    
    p @array;            # no need to pass references
  
  Code above might output something like this (with colors!):
  
     [
         [0] "a",
         [1] "b",
         [2] undef,
         [3] "c",
     ]
  
  You can also inspect objects:
  
      my $obj = SomeClass->new;
  
      p($obj);
  
  Which might give you something like:
  
    \ SomeClass  {
        Parents       Moose::Object
        Linear @ISA   SomeClass, Moose::Object
        public methods (3) : bar, foo, meta
        private methods (0)
        internals: {
           _something => 42,
        }
    }
  
  Data::Printer is fully customizable. If you want to change how things
  are displayed, or even its standard behavior. Take a look at the
  L<< available customizations|/"CUSTOMIZATION" >>. Once you figure out
  your own preferences, create a
  L<< configuration file|/"CONFIGURATION FILE (RUN CONTROL)" >> for
  yourself and Data::Printer will automatically use it!
  
  B<< That's about it! Feel free to stop reading now and start dumping
  your data structures! For more information, including feature set,
  how to create filters, and general tips, just keep reading :) >>
  
  Oh, if you are just experimenting and/or don't want to use a
  configuration file, you can set all options during initialization,
  including coloring, identation and filters!
  
    use Data::Printer {
        color => {
           'regex' => 'blue',
           'hash'  => 'yellow',
        },
        filters => {
           'DateTime' => sub { $_[0]->ymd },
           'SCALAR'   => sub { "oh noes, I found a scalar! $_[0]" },
        },
    };
  
  The first C<{}> block is just syntax sugar, you can safely ommit it
  if it makes things easier to read:
  
    use DDP colored => 1;
  
    use Data::Printer  deparse => 1, sort_keys => 0;
  
  
  =head1 FEATURES
  
  Here's what Data::Printer has to offer to Perl developers, out of the box:
  
  =over 4
  
  =item * Very sane defaults (I hope!)
  
  =item * Highly customizable (in case you disagree with me :)
  
  =item * Colored output by default
  
  =item * Human-friendly output, with array index and custom separators
  
  =item * Full object dumps including methods, inheritance and internals
  
  =item * Exposes extra information such as tainted data and weak references
  
  =item * Ability to easily create filters for objects and regular structures
  
  =item * Ability to load settings from a C<.dataprinter> file so you don't have to write anything other than "use DDP;" in your code!
  
  =back
  
  =head1 RATIONALE
  
  Data::Dumper is a fantastic tool, meant to stringify data structures
  in a way they are suitable for being C<eval>'ed back in.
  
  The thing is, a lot of people keep using it (and similar ones,
  like Data::Dump) to print data structures and objects on screen
  for inspection and debugging, and while you B<can> use those
  modules for that, it doesn't mean mean you B<should>.
  
  This is where Data::Printer comes in. It is meant to do one thing
  and one thing only:
  
  I<< display Perl variables and objects on screen, properly
  formatted >> (to be inspected by a human)
  
  If you want to serialize/store/restore Perl data structures,
  this module will NOT help you. Try L<Storable>, L<Data::Dumper>,
  L<JSON>, or whatever. CPAN is full of such solutions!
  
  =head1 THE p() FUNCTION
  
  Once you load Data::Printer, the C<p()> function will be imported
  into your namespace and available to you. It will pretty-print
  into STDERR (or any other output target) whatever variabe you pass to it.
  
  =head2 Changing output targets
  
  By default, C<p()> will be set to use STDERR. As of version 0.27, you
  can set up the 'output' property so Data::Printer outputs to
  several different places:
  
  =over 4
  
  =item * C<< output => 'stderr' >> - Standard error. Same as *STDERR
  
  =item * C<< output => 'stdout' >> - Standard output. Same as *STDOUT
  
  =item * C<< output => $filename >> - Appends to filename.
  
  =item * C<< output => $file_handle >> - Appends to opened handle
  
  =item * C<< output => \$scalar >> - Appends to that variable's content
  
  =back
  
  =head2 Return Value
  
  If for whatever reason you want to mangle with the output string
  instead of printing it, you can simply ask for a return
  value:
  
    # move to a string
    my $string = p @some_array;
  
    # output to STDOUT instead of STDERR;
    print p(%some_hash);
  
  Note that, in this case, Data::Printer will not colorize the
  returned string unless you explicitly set the C<colored> option to 1:
  
    print p(%some_hash, colored => 1); # now with colors!
  
  You can - and should - of course, set this during you "C<use>" call:
  
    use Data::Printer colored => 1;
    print p( %some_hash );  # will be colored
  
  Or by adding the setting to your C<.dataprinter> file.
  
  As most of Data::Printer, the return value is also configurable. You
  do this by setting the C<return_value> option. There are three options
  available:
  
  =over 4
  
  =item * C<'dump'> (default):
  
      p %var;               # prints the dump to STDERR (void context)
      my $string = p %var;  # returns the dump *without* printing
  
  =item * C<'void'>:
  
      p %var;               # prints the dump to STDERR, never returns.
      my $string = p %var;  # $string is undef. Data still printed in STDERR
  
  
  =item * C<'pass'>:
  
      p %var;               # prints the dump to STDERR, returns %var
      my %copy = p %var;    # %copy = %var. Data still printed in STDERR
  
  =back
  
  =head1 COLORS AND COLORIZATION
  
  Below are all the available colorizations and their default values.
  Note that both spellings ('color' and 'colour') will work.
  
     use Data::Printer {
       color => {
          array       => 'bright_white',  # array index numbers
          number      => 'bright_blue',   # numbers
          string      => 'bright_yellow', # strings
          class       => 'bright_green',  # class names
          method      => 'bright_green',  # method names
          undef       => 'bright_red',    # the 'undef' value
          hash        => 'magenta',       # hash keys
          regex       => 'yellow',        # regular expressions
          code        => 'green',         # code references
          glob        => 'bright_cyan',   # globs (usually file handles)
          vstring     => 'bright_blue',   # version strings (v5.16.0, etc)
          repeated    => 'white on_red',  # references to seen values
          caller_info => 'bright_cyan',   # details on what's being printed
          weak        => 'cyan',          # weak references
          tainted     => 'red',           # tainted content
          escaped     => 'bright_red',    # escaped characters (\t, \n, etc)
  
          # potential new Perl datatypes, unknown to Data::Printer
          unknown     => 'bright_yellow on_blue',
       },
     };
  
  Don't fancy colors? Disable them with:
  
    use Data::Printer colored => 0;
  
  By default, 'colored' is set to C<"auto">, which means Data::Printer
  will colorize only when not being used to return the dump string,
  nor when the output (default: STDERR) is being piped. If you're not
  seeing colors, try forcing it with:
  
    use Data::Printer colored => 1;
  
  Also worth noticing that Data::Printer I<will> honor the
  C<ANSI_COLORS_DISABLED> environment variable unless you force a
  colored output by setting 'colored' to 1.
  
  Remember to put your preferred settings in the C<.dataprinter> file
  so you never have to type them at all!
  
  
  =head1 ALIASING
  
  Data::Printer provides the nice, short, C<p()> function to dump your
  data structures and objects. In case you rather use a more explicit
  name, already have a C<p()> function (why?) in your code and want
  to avoid clashing, or are just used to other function names for that
  purpose, you can easily rename it:
  
    use Data::Printer alias => 'Dumper';
  
    Dumper( %foo );
  
  
  =head1 CUSTOMIZATION
  
  I tried to provide sane defaults for Data::Printer, so you'll never have
  to worry about anything other than typing C<< "p( $var )" >> in your code.
  That said, and besides coloring and filtering, there are several other
  customization options available, as shown below (with default values):
  
    use Data::Printer {
        name           => 'var',   # name to display on cyclic references
        indent         => 4,       # how many spaces in each indent
        hash_separator => '   ',   # what separates keys from values
        colored        => 'auto',  # colorize output (1 for always, 0 for never)
        index          => 1,       # display array indices
        multiline      => 1,       # display in multiple lines (see note below)
        max_depth      => 0,       # how deep to traverse the data (0 for all)
        sort_keys      => 1,       # sort hash keys
        deparse        => 0,       # use B::Deparse to expand (expose) subroutines
        show_tied      => 1,       # expose tied variables
        show_tainted   => 1,       # expose tainted variables
        show_weak      => 1,       # expose weak references
        show_readonly  => 0,       # expose scalar variables marked as read-only
        show_lvalue    => 1,       # expose lvalue types
        print_escapes  => 0,       # print non-printable chars as "\n", "\t", etc.
        escape_chars   => 'none',  # escape chars into \x{...} form.  Values are
                                   # "none", "nonascii", "nonlatin1", "all"
        quote_keys     => 'auto',  # quote hash keys (1 for always, 0 for never).
                                   # 'auto' will quote when key is empty/space-only.
        separator      => ',',     # uses ',' to separate array/hash elements
        end_separator  => 0,       # prints the separator after last element in array/hash.
                                   # the default is 0 that means not to print
  
        caller_info    => 0,       # include information on what's being printed
        use_prototypes => 1,       # allow p(%foo), but prevent anonymous data
        return_value   => 'dump',  # what should p() return? See 'Return Value' above.
        output         => 'stderr',# where to print the output. See
                                   # 'Changing output targets' above.
  
        class_method   => '_data_printer', # make classes aware of Data::Printer
                                           # and able to dump themselves.
  
        class => {
            internals  => 1,       # show internal data structures of classes
  
            inherited  => 'none',  # show inherited methods,
                                   # can also be 'all', 'private', or 'public'.
  
            universal  => 1,       # include UNIVERSAL methods in inheritance list
  
            parents    => 1,       # show parents, if there are any
            linear_isa => 'auto',  # show the entire @ISA, linearized, whenever
                                   # the object has more than one parent. Can
                                   # also be set to 1 (always show) or 0 (never).
  
            expand     => 1,       # how deep to traverse the object (in case
                                   # it contains other objects). Defaults to
                                   # 1, meaning expand only itself. Can be any
                                   # number, 0 for no class expansion, and 'all'
                                   # to expand everything.
  
            sort_methods => 1,     # sort public and private methods
  
            show_methods => 'all'  # method list. Also 'none', 'public', 'private'
        },
    };
  
  Note: setting C<multiline> to C<0> will also set C<index> and C<indent> to C<0>.
  
  =head1 FILTERS
  
  Data::Printer offers you the ability to use filters to override
  any kind of data display. The filters are placed on a hash,
  where keys are the types - or class names - and values
  are anonymous subs that receive two arguments: the item itself
  as first parameter, and the properties hashref (in case your
  filter wants to read from it). This lets you quickly override
  the way Data::Printer handles and displays data types and, in
  particular, objects.
  
    use Data::Printer filters => {
              'DateTime'      => sub { $_[0]->ymd },
              'HTTP::Request' => sub { $_[0]->uri },
    };
  
  Perl types are named as C<ref> calls them: I<SCALAR>, I<ARRAY>,
  I<HASH>, I<REF>, I<CODE>, I<Regexp> and I<GLOB>. As for objects,
  just use the class' name, as shown above.
  
  As of version 0.13, you may also use the '-class' filter, which
  will be called for all non-perl types (objects).
  
  Your filters are supposed to return a defined value (usually, the
  string you want to print). If you don't, Data::Printer will
  let the next filter of that same type have a go, or just fallback
  to the defaults. You can also use an array reference to pass more
  than one filter for the same type or class.
  
  B<Note>: If you plan on calling C<p()> from I<within> an inline
  filter, please make sure you are passing only REFERENCES as
  arguments. See L</CAVEATS> below.
  
  You may also like to specify standalone filter modules. Please
  see L<Data::Printer::Filter> for further information on a more
  powerful filter interface for Data::Printer, including useful
  filters that are shipped as part of this distribution.
  
  =head1 MAKING YOUR CLASSES DDP-AWARE (WITHOUT ADDING ANY DEPS)
  
  Whenever printing the contents of a class, Data::Printer first
  checks to see if that class implements a sub called '_data_printer'
  (or whatever you set the "class_method" option to in your settings,
  see L</CUSTOMIZATION> below).
  
  If a sub with that exact name is available in the target object,
  Data::Printer will use it to get the string to print instead of
  making a regular class dump.
  
  This means you could have the following in one of your classes:
  
    sub _data_printer {
        my ($self, $properties) = @_;
        return 'Hey, no peeking! But foo contains ' . $self->foo;
    }
  
  Notice you don't have to depend on Data::Printer at all, just
  write your sub and it will use that to pretty-print your objects.
  
  If you want to use colors and filter helpers, and still not
  add Data::Printer to your dependencies, remember you can import
  them during runtime:
  
    sub _data_printer {
        require Data::Printer::Filter;
        Data::Printer::Filter->import;
  
        # now we have 'indent', outdent', 'linebreak', 'p' and 'colored'
        my ($self, $properties) = @_;
        ...
    }
  
  Having a filter for that particular class will of course override
  this setting.
  
  
  =head1 CONFIGURATION FILE (RUN CONTROL)
  
  Data::Printer tries to let you easily customize as much as possible
  regarding the visualization of your data structures and objects.
  But we don't want you to keep repeating yourself every time you
  want to use it!
  
  To avoid this, you can simply create a file called C<.dataprinter> in
  your home directory (usually C</home/username> in Linux), and put
  your configuration hash reference in there.
  
  This way, instead of doing something like:
  
     use Data::Printer {
       colour => {
          array => 'bright_blue',
       },
       filters => {
           'Catalyst::Request' => sub {
               my $req = shift;
               return "Cookies: " . p($req->cookies)
           },
       },
     };
  
  You can create a .dataprinter file that looks like this:
  
     {
       colour => {
          array => 'bright_blue',
       },
       filters => {
           'Catalyst::Request' => sub {
               my $req = shift;
               return "Cookies: " . p($req->cookies)
           },
       },
     };
  
  Note that all we did was remove the "use Data::Printer" bit when
  writing the C<.dataprinter> file. From then on all you have to do
  while debugging scripts is:
  
    use Data::Printer;
  
  and it will load your custom settings every time :)
  
  =head2 Loading RC files in custom locations
  
  If your RC file is somewhere other than C<.dataprinter> in your home
  dir, you can load whichever file you want via the C<'rc_file'> parameter:
  
    use Data::Printer rc_file => '/path/to/my/rcfile.conf';
  
  You can even set this to undef or to a non-existing file to disable your
  RC file at will.
  
  The RC file location can also be specified with the C<DATAPRINTERRC>
  environment variable. Using C<rc_file> in code will override the environment
  variable.
  
  =head2 RC File Security
  
  The C<.dataprinter> RC file is nothing but a Perl hash that
  gets C<eval>'d back into the code. This means that whatever
  is in your RC file B<WILL BE INTERPRETED BY PERL AT RUNTIME>.
  This can be quite worrying if you're not the one in control
  of the RC file.
  
  For this reason, Data::Printer takes extra precaution before
  loading the file:
  
  =over 4
  
  =item * The file has to be in your home directory unless you
  specifically point elsewhere via the 'C<rc_file>' property or
  the DATAPRINTERRC environment variable;
  
  =item * The file B<must> be a plain file, never a symbolic
  link, named pipe or socket;
  
  =item * The file B<must> be owned by you (i.e. the effective
  user id that ran the script using Data::Printer);
  
  =item * The file B<must> be read-only for everyone but your user.
  This usually means permissions C<0644>, C<0640> or C<0600> in
  Unix-like systems. B<THIS IS NOT CHECKED IN WIN32>;
  
  =item * The file will B<NOT> be loaded in Taint mode, unless
  you specifically load Data::Printer with the 'allow_tainted'
  option set to true. And even if you do that, Data::Printer
  will still issue a warning before loading the file. But
  seriously, don't do that.
  
  =back
  
  Failure to comply with the security rules above will result in
  the RC file not being loaded (likely with a warning on what went
  wrong).
  
  
  =head1 THE "DDP" PACKAGE ALIAS
  
  You're likely to add/remove Data::Printer from source code being
  developed and debugged all the time, and typing it might feel too
  long. Because of this, the 'DDP' package is provided as a shorter
  alias to Data::Printer:
  
     use DDP;
     p %some_var;
  
  =head1 CALLER INFORMATION
  
  If you set caller_info to a true value, Data::Printer will prepend
  every call with an informational message. For example:
  
    use Data::Printer caller_info => 1;
  
    my $var = 42;
    p $var;
  
  will output something like:
  
    Printing in line 4 of myapp.pl:
    42
  
  The default message is C<< 'Printing in line __LINE__ of __FILENAME__:' >>.
  The special strings C<__LINE__>, C<__FILENAME__> and C<__PACKAGE__> will
  be interpolated into their according value so you can customize them at will:
  
    use Data::Printer
      caller_info => 1,
      caller_message => "Okay, __PACKAGE__, let's dance!"
      color => {
          caller_info => 'bright_red',
      };
  
  As shown above, you may also set a color for "caller_info" in your color
  hash. Default is cyan.
  
  
  =head1 EXPERIMENTAL FEATURES
  
  The following are volatile parts of the API which are subject to
  change at any given version. Use them at your own risk.
  
  =head2 Local Configuration (experimental!)
  
  You can override global configurations by writing them as the second
  parameter for p(). For example:
  
    p( %var, color => { hash => 'green' } );
  
  
  =head2 Filter classes
  
  As of Data::Printer 0.11, you can create complex filters as a separate
  module. Those can even be uploaded to CPAN and used by other people!
  See L<Data::Printer::Filter> for further information.
  
  =head1 CAVEATS
  
  You can't pass more than one variable at a time.
  
     p($foo, $bar); # wrong
     p($foo);       # right
     p($bar);       # right
  
  The default mode is to use prototypes, in which you are supposed to pass
  variables, not anonymous structures:
  
     p( { foo => 'bar' } ); # wrong
  
     p %somehash;        # right
     p $hash_ref;        # also right
  
  To pass anonymous structures, set "use_prototypes" option to 0. But
  remember you'll have to pass your variables as references:
  
     use Data::Printer use_prototypes => 0;
  
     p( { foo => 'bar' } ); # was wrong, now is right.
  
     p( %foo  ); # was right, but fails without prototypes
     p( \%foo ); # do this instead
  
  If you are using inline filters, and calling p() (or whatever name you
  aliased it to) from inside those filters, you B<must> pass the arguments
  to C<p()> as a reference:
  
    use Data::Printer {
        filters => {
            ARRAY => sub {
                my $listref = shift;
                my $string = '';
                foreach my $item (@$listref) {
                    $string .= p( \$item );      # p( $item ) will not work!
                }
                return $string;
            },
        },
    };
  
  This happens because your filter function is compiled I<before> Data::Printer
  itself loads, so the filter does not see the function prototype. As a way
  to avoid unpleasant surprises, if you forget to pass a reference, Data::Printer
  will generate an exception for you with the following message:
  
      'When calling p() without prototypes, please pass arguments as references'
  
  Another way to avoid this is to use the much more complete L<Data::Printer::Filter>
  interface for standalone filters.
  
  =head1 EXTRA TIPS
  
  =head2 Circumventing prototypes
  
  The C<p()> function uses prototypes by default, allowing you to say:
  
    p %var;
  
  instead of always having to pass references, like:
  
    p \%var;
  
  There are cases, however, where you may want to pass anonymous
  structures, like:
  
    p { foo => $bar };   # this blows up, don't use
  
  and because of prototypes, you can't. If this is your case, just
  set "use_prototypes" option to 0. Note, with this option,
  you B<will> have to pass your variables as references:
  
    use Data::Printer use_prototypes => 0;
  
     p { foo => 'bar' }; # doesn't blow up anymore, works just fine.
  
     p %var;  # but now this blows up...
     p \%var; # ...so do this instead
  
     p [ $foo, $bar, \@baz ]; # this way you can even pass
                              # several variables at once
  
  Versions prior to 0.17 don't have the "use_prototypes" option. If
  you're stuck in an older version you can write C<&p()> instead of C<p()>
  to circumvent prototypes and pass elements (including anonymous variables)
  as B<REFERENCES>. This notation, however, requires enclosing parentheses:
  
    &p( { foo => $bar } );        # this is ok, use at will
    &p( \"DEBUGGING THIS BIT" );  # this works too
  
  Or you could just create a very simple wrapper function:
  
    sub pp { p @_ };
  
  And use it just as you use C<p()>.
  
  =head2 Minding the return value of p()
  
  I<< (contributed by Matt S. Trout (mst)) >>
  
  There is a reason why explicit return statements are recommended unless
  you know what you're doing. By default, Data::Printer's return value
  depends on how it was called. When not in void context, it returns the
  serialized form of the dump.
  
  It's tempting to trust your own p() calls with that approach, but if
  this is your I<last> statement in a function, you should keep in mind
  your debugging code will behave differently depending on how your
  function was called!
  
  To prevent that, set the C<return_value> property to either 'void'
  or 'pass'. You won't be able to retrieve the dumped string but, hey,
  who does that anyway :)
  
  Assuming you have set the pass-through ('pass') property in your
  C<.dataprinter> file, another stunningly useful thing you can do with it
  is change code that says:
  
     return $obj->foo;
  
  with:
  
     use DDP;
  
     return p $obj->foo;
  
  You can even add it to chained calls if you wish to see the dump of
  a particular state, changing this:
  
     $obj->foo->bar->baz;
  
  to:
  
     $obj->foo->DDP::p->bar->baz
  
  And things will "Just Work".
  
  
  =head2 Using p() in some/all of your loaded modules
  
  I<< (contributed by Matt S. Trout (mst)) >>
  
  While debugging your software, you may want to use Data::Printer in
  some or all loaded modules and not bother having to load it in
  each and every one of them. To do this, in any module loaded by
  C<myapp.pl>, simply write:
  
    ::p( @myvar );  # note the '::' in front of p()
  
  Then call your program like:
  
    perl -MDDP myapp.pl
  
  This also has the great advantage that if you leave one p() call
  in by accident, it will fail without the -M, making it easier to spot :)
  
  If you really want to have p() imported into your loaded
  modules, use the next tip instead.
  
  =head2 Adding p() to all your loaded modules
  
  I<< (contributed by Árpád Szász) >>
  
  If you wish to automatically add Data::Printer's C<p()> function to
  every loaded module in you app, you can do something like this to
  your main program:
  
      BEGIN {
          {
              no strict 'refs';
              require Data::Printer;
              my $alias = 'p';
              foreach my $package ( keys %main:: ) {
                  if ( $package =~ m/::$/ ) {
                      *{ $package . $alias } = \&Data::Printer::p;
                  }
              }
          }
      }
  
  B<WARNING> This will override all locally defined subroutines/methods that
  are named C<p>, if they exist, in every loaded module. If you already
  have a subroutine named 'C<p()>', be sure to change C<$alias> to
  something custom.
  
  If you rather avoid namespace manipulation altogether, use the previous
  tip instead.
  
  =head2 Using Data::Printer from the Perl debugger
  
  I<< (contributed by Árpád Szász and Marcel Grünauer (hanekomu)) >>
  
  With L<DB::Pluggable>, you can easily set the perl debugger to use
  Data::Printer to print variable information, replacing the debugger's
  standard C<p()> function. All you have to do is add these lines to
  your C<.perldb> file:
  
    use DB::Pluggable;
    DB::Pluggable->run_with_config( \'[DataPrinter]' );  # note the '\'
  
  Then call the perl debugger as you normally would:
  
    perl -d myapp.pl
  
  Now Data::Printer's C<p()> command will be used instead of the debugger's!
  
  See L<perldebug> for more information on how to use the perl debugger, and
  L<DB::Pluggable> for extra functionality and other plugins.
  
  If you can't or don't wish to use DB::Pluggable, or simply want to keep
  the debugger's C<p()> function and add an extended version using
  Data::Printer (let's call it C<px()> for instance), you can add these
  lines to your C<.perldb> file instead:
  
      $DB::alias{px} = 's/px/DB::px/';
      sub px {
          my $expr = shift;
          require Data::Printer;
          print Data::Printer::p($expr);
      }
  
  Now, inside the Perl debugger, you can pass as reference to C<px> expressions
  to be dumped using Data::Printer.
  
  =head2 Using Data::Printer in a perl shell (REPL)
  
  Some people really enjoy using a REPL shell to quickly try Perl code. One
  of the most famous ones out there is L<Devel::REPL>. If you use it, now
  you can also see its output with Data::Printer!
  
  Just install L<Devel::REPL::Plugin::DataPrinter> and add the following
  line to your re.pl configuration file (usually ".re.pl/repl.rc" in your
  home dir):
  
    load_plugin('DataPrinter');
  
  The next time you run C<re.pl>, it should dump all your REPL using
  Data::Printer!
  
  =head2 Easily rendering Data::Printer's output as HTML
  
  To turn Data::Printer's output into HTML, you can do something like:
  
    use HTML::FromANSI;
    use Data::Printer;
    
    my $html_output = ansi2html( p($object, colored => 1) );
  
  In the example above, the C<$html_output> variable contains the
  HTML escaped output of C<p($object)>, so you can print it for
  later inspection or render it (if it's a web app).
  
  =head2 Using Data::Printer with Template Toolkit
  
  I<< (contributed by Stephen Thirlwall (sdt)) >>
  
  If you use Template Toolkit and want to dump your variables using Data::Printer,
  install the L<Template::Plugin::DataPrinter> module and load it in your template:
  
     [% USE DataPrinter %]
  
  The provided methods match those of C<Template::Plugin::Dumper>:
  
     ansi-colored dump of the data structure in "myvar":
     [% DataPrinter.dump( myvar ) %]
  
     html-formatted, colored dump of the same data structure:
     [% DataPrinter.dump_html( myvar ) %]
  
  The module allows several customization options, even letting you load it as a
  complete drop-in replacement for Template::Plugin::Dumper so you don't even have
  to change your previous templates!
  
  =head2 Unified interface for Data::Printer and other debug formatters
  
  I<< (contributed by Kevin McGrath (catlgrep)) >>
  
  If you are porting your code to use Data::Printer instead of
  Data::Dumper or similar, you can just replace:
  
    use Data::Dumper;
  
  with:
  
    use Data::Printer alias => 'Dumper';
    # use Data::Dumper;
  
  making sure to provide Data::Printer with the proper alias for the
  previous dumping function.
  
  If, however, you want a really unified approach where you can easily
  flip between debugging outputs, use L<Any::Renderer> and its plugins,
  like L<Any::Renderer::Data::Printer>.
  
  =head2 Printing stack traces with arguments expanded using Data::Printer
  
  I<< (contributed by Sergey Aleynikov (randir)) >>
  
  There are times where viewing the current state of a variable is not
  enough, and you want/need to see a full stack trace of a function call.
  
  The L<Devel::PrettyTrace> module uses Data::Printer to provide you just
  that. It exports a C<bt()> function that pretty-prints detailed information
  on each function in your stack, making it easier to spot any issues!
  
  =head2 Troubleshooting apps in real time without changing a single line of your code
  
  I<< (contributed by Marcel Grünauer (hanekomu)) >>
  
  L<dip> is a dynamic instrumentation framework for troubleshooting Perl
  programs, similar to L<DTrace|http://opensolaris.org/os/community/dtrace/>.
  In a nutshell, C<dip> lets you create probes for certain conditions
  in your application that, once met, will perform a specific action. Since
  it uses Aspect-oriented programming, it's very lightweight and you only
  pay for what you use.
  
  C<dip> can be very useful since it allows you to debug your software
  without changing a single line of your original code. And Data::Printer
  comes bundled with it, so you can use the C<p()> function to view your
  data structures too!
  
     # Print a stack trace every time the name is changed,
     # except when reading from the database.
     dip -e 'before { print longmess(p $_->{args}[1]) if $_->{args}[1] }
       call "MyObj::name" & !cflow("MyObj::read")' myapp.pl
  
  You can check you L<dip>'s own documentation for more information and options.
  
  =head2 Sample output for color fine-tuning
  
  I<< (contributed by Yanick Champoux (yanick)) >>
  
  The "examples/try_me.pl" file included in this distribution has a sample
  dump with a complex data structure to let you quickly test color schemes.
  
  =head2 creating fiddling filters
  
  I<< (contributed by dirk) >>
  
  Sometimes, you may want to take advantage of Data::Printer's original dump,
  but add/change some of the original data to enhance your debugging ability.
  Say, for example, you have an C<HTTP::Response> object you want to print
  but the content is encoded. The basic approach, of course, would be to
  just dump the decoded content:
  
    use DDP filter {
      'HTTP::Response' => sub { p( \shift->decoded_content, %{shift} );
    };
  
  But what if you want to see the rest of the original object? Dumping it
  would be a no-go, because you would just recurse forever in your own filter.
  
  Never fear! When you create a filter in Data::Printer, you're not replacing
  the original one, you're just stacking yours on top of it. To forward your data
  to the original filter, all you have to do is return an undefined value. This
  means you can rewrite your C<HTTP::Response> filter like so, if you want:
  
    use DDP filters => {
      'HTTP::Response' => sub {
        my ($res, $p) = @_;
  
        # been here before? Switch to original handler
        return if exists $res->{decoded_content};
  
        # first timer? Come on in!
        my $clone = $res->clone;
        $clone->{decoded_content} = $clone->decoded_content;
        return p($clone, %$p);
      }
    };
  
  And voilà! Your fiddling filter now works like a charm :)
  
  =head1 BUGS
  
  If you find any, please file a bug report.
  
  
  =head1 SEE ALSO
  
  L<Data::Dumper>
  
  L<Data::Dump>
  
  L<Data::Dumper::Concise>
  
  L<Data::Dump::Streamer>
  
  L<Data::PrettyPrintObjects>
  
  L<Data::TreeDumper>
  
  
  =head1 AUTHOR
  
  Breno G. de Oliveira C<< <garu at cpan.org> >>
  
  =head1 CONTRIBUTORS
  
  Many thanks to everyone that helped design and develop this module
  with patches, bug reports, wishlists, comments and tests. They are
  (alphabetically):
  
  =over 4
  
  =item * Allan Whiteford
  
  =item * Andreas König
  
  =item * Andy Bach
  
  =item * Árpád Szász
  
  =item * brian d foy
  
  =item * Chris Prather (perigrin)
  
  =item * David Golden (xdg)
  
  =item * David Raab
  
  =item * Damien Krotkine (dams)
  
  =item * Denis Howe
  
  =item * Dotan Dimet
  
  =item * Eden Cardim (edenc)
  
  =item * Elliot Shank (elliotjs)
  
  =item * Fernando Corrêa (SmokeMachine)
  
  =item * Fitz Elliott
  
  =item * Ivan Bessarabov (bessarabv)
  
  =item * J Mash
  
  =item * Jesse Luehrs (doy)
  
  =item * Joel Berger (jberger)
  
  =item * Kartik Thakore (kthakore)
  
  =item * Kevin Dawson (bowtie)
  
  =item * Kevin McGrath (catlgrep)
  
  =item * Kip Hampton (ubu)
  
  =item * Marcel Grünauer (hanekomu)
  
  =item * Mark Fowler (Trelane)
  
  =item * Matt S. Trout (mst)
  
  =item * Maxim Vuets
  
  =item * Mike Doherty (doherty)
  
  =item * Paul Evans (LeoNerd)
  
  =item * Przemysław Wesołek (jest)
  
  =item * Rebecca Turner (iarna)
  
  =item * Rob Hoelz (hoelzro)
  
  =item * Sebastian Willing (Sewi)
  
  =item * Sergey Aleynikov (randir)
  
  =item * Stanislaw Pusep (syp)
  
  =item * Stephen Thirlwall (sdt)
  
  =item * sugyan
  
  =item * Tatsuhiko Miyagawa (miyagawa)
  
  =item * Tim Heaney (oylenshpeegul)
  
  =item * Torsten Raudssus (Getty)
  
  =item * Wesley Dal`Col (blabos)
  
  =item * Yanick Champoux (yanick)
  
  =back
  
  If I missed your name, please drop me a line!
  
  
  =head1 LICENSE AND COPYRIGHT
  
  Copyright 2011 Breno G. de Oliveira C<< <garu at cpan.org> >>. All rights reserved.
  
  This module is free software; you can redistribute it and/or modify it
  under the same terms as Perl itself. See L<perlartistic>.
  
  
  
  =head1 DISCLAIMER OF WARRANTY
  
  BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
  FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
  OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
  PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
  EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
  ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
  YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
  NECESSARY SERVICING, REPAIR, OR CORRECTION.
  
  IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
  WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
  REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
  LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
  OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
  THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
  RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
  FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
  SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
  SUCH DAMAGES.
  
  
  
DATA_PRINTER

$fatpacked{"Data/Printer/Filter.pm"} = <<'DATA_PRINTER_FILTER';
  package Data::Printer::Filter;
  use strict;
  use warnings;
  use Clone::PP qw(clone);
  require Carp;
  require Data::Printer;
  
  my %_filters_for   = ();
  my %_extras_for    = ();
  
  sub import {
      my $caller = caller;
      my $id = Data::Printer::_object_id( \$caller );
  
      my %properties = ();
  
      my $filter = sub {
          my ($type, $code, $extra) = @_;
  
          Carp::croak( "syntax: filter 'Class', sub { ... }" )
            unless $type and $code and ref $code eq 'CODE';
  
          if ($extra) {
              Carp::croak( 'extra filter field must be a hashref' )
                  unless ref $extra and ref $extra eq 'HASH';
  
              $_extras_for{$id}{$type} = $extra;
          }
          else {
              $_extras_for{$id}{$type} = {};
          }
  
          unshift @{ $_filters_for{$id}{$type} }, sub {
              my ($item, $p) = @_;
  
              # send our closured %properties var instead
              # so newline(), indent(), etc can work it
              %properties = %{ clone $p };
              delete $properties{filters}; # no need to rework filters
              $code->($item, \%properties);
          };
      };
  
      my $filters = sub {
          return $_filters_for{$id};
      };
  
      my $extras = sub {
          return $_extras_for{$id};
      };
  
      my $newline = sub {
          return ${$properties{_linebreak}} . (' ' x $properties{_current_indent});
      };
  
      my $indent = sub {
          $properties{_current_indent} += $properties{indent};
          $properties{_depth}++;
          return;
      };
  
      my $outdent = sub {
          $properties{_current_indent} -= $properties{indent};
          $properties{_depth}--;
          return;
      };
  
      my $imported = sub (\[@$%&];%) {
          my ($item, $p) = @_;
          return Data::Printer::p( $item, %properties );
      };
  
      {
          no strict 'refs';
          *{"$caller\::filter"}  = $filter;
          *{"$caller\::indent"}  = $indent;
          *{"$caller\::outdent"} = $outdent;
          *{"$caller\::newline"} = $newline;
  
          *{"$caller\::p"} = $imported;
  
          *{"$caller\::_filter_list"}   = $filters;
          *{"$caller\::_extra_options"} = $extras;
      }
  };
  
  
  1;
  __END__
  
  =head1 NAME
  
  Data::Printer::Filter - Create powerful stand-alone filters for Data::Printer
  
  =head1 SYNOPSIS
  
  Create your filter module:
  
    package Data::Printer::Filter::MyFilter;
    use strict;
    use warnings;
  
    use Data::Printer::Filter;
  
    # type filter
    filter 'SCALAR', sub {
        my ($ref, $properties) = @_;
        my $val = $$ref;
        
        if ($val > 100) {
            return 'too big!!';
        }
        else {
            return $val;
        }
    };
  
    # you can also filter objects of any class
    filter 'Some::Class', sub {
        my ($object, $properties) = @_;
  
        return $ref->some_method;   # or whatever
  
        # see 'HELPER FUNCTIONS' below for
        # customization options, including
        # proper indentation.
    };
  
    1;
  
  
  Later, in your main code:
  
    use Data::Printer {
        filters => {
            -external => [ 'MyFilter', 'OtherFilter' ],
  
            # you can still add regular (inline) filters
            SCALAR => sub {
                ...
            }
        },
    };
  
  
  
  =head1 WARNING - ALPHA CODE (VERY LOOSE API)
  
  We are still experimenting with the standalone filter syntax, so
  B<< filters written like so may break in the future without any warning! >>
  
  B<< If you care, or have any suggestions >>, please drop me a line via RT, email,
  or find me ('garu') on irc.perl.org.
  
  You have been warned.
  
  
  =head1 DESCRIPTION
  
  L<Data::Printer> lets you add custom filters to display data structures and
  objects, by either specifying them during "use", in the C<.dataprinter>
  configuration file, or even in runtime customizations.
  
  But there are times when you may want to group similar filters, or make
  them standalone in order to be easily reutilized in other environments and
  applications, or even upload them to CPAN so other people can benefit from
  a cleaner - and clearer - object/structure dump.
  
  This is where C<Data::Printer::Filter> comes in. It B<exports> into your
  package's namespace the L</filter> function, along with some helpers to
  create custom filter packages.
  
  L<Data::Printer> recognizes all filters in the C<Data::Printer::Filter::*>
  namespace. You can load them by specifying them in the '-external' filter
  list (note the dash, to avoid clashing with a potential class or pragma
  labelled 'external'):
  
    use Data::Printer {
        filters => {
            -external => 'MyFilter',
        },
    };
  
  This will load all filters defined by the C<Data::Printer::Filter::MyFilter>
  module.
  
  If there are more than one filter, use an array reference instead:
  
    -external => [ 'MyFilter', 'MyOtherFilter' ]
  
  B<< IMPORTANT: THIS WAY OF LOADING EXTERNAL PLUGINS IS EXPERIMENTAL AND
  SUBJECT TO SUDDEN CHANGE! IF YOU CARE, AND/OR HAVE IDEAS ON A BETTER API,
  PLEASE LET US KNOW >>
  
  =head1 HELPER FUNCTIONS
  
  =head2 filter TYPE, sub { ... };
  
  The C<filter> function creates a new filter for I<TYPE>, using
  the given subref. The subref receives two arguments: the item
  itself - be it an object or a reference to a standard Perl type -
  and the properties in effect (so you can inspect for certain
  options, etc). The subroutine is expected to return a string
  containing whatever it wants C<Data::Printer> to display on screen.
  
  =head2 p()
  
  This is the same as C<Data::Printer>'s p(), only you can't rename it.
  You can use this to throw some data structures back at C<Data::Printer>
  and use the results in your own return string - like when manipulating
  hashes or arrays.
  
  =head2 newline()
  
  This helper returns a string using the linebreak as specified by the
  caller's settings. For instance, it provides the proper indentation
  level of spaces for you and considers the C<multiline> option to
  avoid line breakage.
  
  In other words, if you do this:
  
     filter ARRAY => {
         my ($ref, $p) = @_;
         my $string = "Hey!! I got this array:";
  
         foreach my $val (@$ref) {
             $string .= newline . p($val);
         }
  
         return $string;
     };
  
  ... your C<p($val)> returns will be properly indented, vertically aligned
  to your level of the data structure, while simply using "\n" would just
  make things messy if your structure has more than one level of depth.
  
  =head2 indent()
  
  =head2 outdent()
  
  These two helpers let you increase/decrease the indentation level of
  your data display, for C<newline()> and nested C<p()> calls inside your filters.
  
  For example, the filter defined in the C<newline> explanation above would
  show the values on the same (vertically aligned) level as the "I got this array"
  message. If you wanted your array to be one level further deep, you could use
  this instead:
  
    filter ARRAY => {
        my ($ref, $p) = @_;
        my $string = "Hey!! I got this array:";
  
        indent;
        foreach my $val (@$ref) {
            $string .= newline . p($val);
        }
        outdent;
  
        return $string;
    };
  
  
  =head1 COLORIZATION
  
  You can use L<Term::ANSIColor>'s C<colored()>' for string
  colorization. Data::Printer will automatically enable/disable
  colors for you.
  
  =head1 EXISTING FILTERS
  
  This is meant to provide a complete list of standalone filters for
  Data::Printer available on CPAN. If you write one, please put it under
  the C<Data::Printer::Filter::*> namespace, and drop me a line so I can
  add it to this list!
  
  =head2 Databases
  
  L<Data::Printer::Filter::DB> provides filters for Database objects. So
  far only DBI is covered, but more to come!
  
  =head2 Dates & Times
  
  L<Data::Printer::Filter::DateTime> pretty-prints several date
  and time objects (not just DateTime) for you on the fly, including
  duration/delta objects!
  
  =head2 Digest
  
  L<Data::Printer::Filter::Digest> displays a string containing the
  hash of the actual message digest instead of the object. Works on
  C<Digest::MD5>, C<Digest::SHA>, any digest class that inherits from
  C<Digest::base> and some others that implement their own thing!
  
  =head2 ClassicRegex
  
  L<Data::Printer::Filter::ClassicRegex> changes the way Data::Printer
  dumps regular expressions, doing it the classic C<qr//> way that got
  popular in C<Data::Dumper>.
  
  =head2 URI
  
  L<Data::Printer::Filter::URI> pretty-prints L<URI> objects, displaying
  the URI as a string instead of dumping the object.
  
  =head2 JSON
  
  L<Data::Printer::Filter::JSON> lets you see your JSON structures
  replacing boolean objects with simple C<true/false> strings!
  
  =head2 URIs
  
  L<Data::Printer::Filter::URI> filters through several L<URI> manipulation
  classes and displays the URI as a colored string. A very nice addition
  by Stanislaw Pusep (SYP).
  
  =head1 USING MORE THAN ONE FILTER FOR THE SAME TYPE/CLASS
  
  As of version 0.13, standalone filters let you stack together
  filters for the same type or class. Filters of the same type are
  called in order, until one of them returns a string. This lets
  you have several filters inspecting the same given value until
  one of them decides to actually treat it somehow.
  
  If your filter catched a value and you don't want to treat it,
  simply return and the next filter will be called. If there are no
  other filters for that particular class or type available, the
  standard Data::Printer calls will be used.
  
  For example:
  
    filter SCALAR => sub {
        my ($ref, $properties) = @_;
        if ( Scalar::Util::looks_like_number $$ref ) {
            return sprintf "%.8d", $$ref;
        }
        return; # lets the other SCALAR filter have a go
    };
  
    filter SCALAR => sub {
        my ($ref, $properties) = @_;
        return qq["$$ref"];
    };
  
  Note that this "filter stack" is not possible on inline filters, since
  it's a hash and keys with the same name are overwritten. Instead, you
  can pass them as an array reference:
  
    use Data::Printer filters => {
        SCALAR => [ sub { ... }, sub { ... } ],
    };
  
  
  =head1 SEE ALSO
  
  L<Data::Printer>
  
  
  =head1 LICENSE AND COPYRIGHT
  
  Copyright 2011 Breno G. de Oliveira C<< <garu at cpan.org> >>. All rights reserved.
  
  This module is free software; you can redistribute it and/or modify it
  under the same terms as Perl itself. See L<perlartistic>.
  
  
DATA_PRINTER_FILTER

$fatpacked{"Data/Printer/Filter/DB.pm"} = <<'DATA_PRINTER_FILTER_DB';
  package Data::Printer::Filter::DB;
  use strict;
  use warnings;
  use Data::Printer::Filter;
  use Term::ANSIColor;
  
  filter 'DBI::db', sub {
      my ($dbh, $p) = @_;
      my $name = $dbh->{Driver}{Name};
  
      my $string = "$name Database Handle ("
                 . ($dbh->{Active} 
                    ? colored('connected', 'bright_green')
                    : colored('disconnected', 'bright_red'))
                 . ') {'
                 ;
      indent;
      my %dsn = split( /[;=]/, $dbh->{Name} );
      foreach my $k (keys %dsn) {
          $string .= newline . "$k: " . $dsn{$k};
      }
      $string .= newline . 'Auto Commit: ' . $dbh->{AutoCommit};
  
      my $kids = $dbh->{Kids};
      $string .= newline . 'Statement Handles: ' . $kids;
      if ($kids > 0) {
          $string .= ' (' . $dbh->{ActiveKids} . ' active)';
      }
  
      if ( defined $dbh->err ) {
          $string .= newline . 'Error: ' . $dbh->errstr;
      }
      $string .= newline . 'Last Statement: '
              . colored( ($dbh->{Statement} || '-'), 'bright_yellow');
  
      outdent;
      $string .= newline . '}';
      return $string;
  };
  
  filter 'DBI::st', sub {
      my ($sth, $properties) = @_;
      my $str = colored( ($sth->{Statement} || '-'), 'bright_yellow');
  
      if ($sth->{NUM_OF_PARAMS} > 0) {
          my $values = $sth->{ParamValues};
          if ($values) {
              $str .= '  (' 
                   . join(', ',
                        map {
                           my $v = $values->{$_};
                           $v || 'undef';
                        } 1 .. $sth->{NUM_OF_PARAMS}
                     )
                   . ')';
          }
          else {
              $str .= colored('  (bindings unavailable)', 'yellow');
          }
      }
      return $str;
  };
  
  # DBIx::Class filters
  filter '-class' => sub {
      my ($obj, $properties) = @_;
  
      if ( $obj->isa('DBIx::Class::Schema') ) {
          return ref($obj) . ' DBIC Schema with ' . p( $obj->storage->dbh );
      }
      elsif ( grep { $obj->isa($_) } qw(DBIx::Class::ResultSet DBIx::Class::ResultSetColumn) ) {
  
          my $str = colored( ref($obj), $properties->{color}{class} );
          $str .= ' (' . $obj->result_class . ')'
            if $obj->can( 'result_class' );
  
          if (my $query_data = $obj->as_query) {
            my @query_data = @$$query_data;
            indent;
            my $sql = shift @query_data;
            $str .= ' {'
                 . newline . colored($sql, 'bright_yellow')
                 . newline . join ( newline, map {
                        $_->[1] . ' (' . $_->[0]{sqlt_datatype} . ')'
                      } @query_data
                 )
                 ;
            outdent;
            $str .= newline . '}';
          }
  
          return $str;
      }
      else {
          return;
      }
  };
  
  
  1;
  __END__
  
  =head1 NAME
  
  Data::Printer::Filter::DB - pretty printing database objects
  
  
  =head1 SYNOPSIS
  
  In your program:
  
    use Data::Printer filters => {
        -external => [ 'DB' ],
    };
  
  or, in your C<.dataprinter> file:
  
    {
      filters => {
        -external => [ 'DB' ],
      },
    };
  
  
  
  =head1 DESCRIPTION
  
  This is a filter plugin for L<Data::Printer>. It filters through
  L<DBI>'s handlers (dbh) and statement (sth) objects displaying relevant
  information for the user.
  
  L<DBI> is an extremely powerful and complete database interface. But
  it does a lot of magic under the hood, making their objects somewhat harder
  to debug. This filter aims to fix that :)
  
  For instance, say you want to debug something like this:
  
    use DBI;
    my $dbh = DBI->connect('dbi:DBM(RaiseError=1):', undef, undef );
  
  A regular Data::Dumper output gives you absolutely nothing:
  
  $VAR1 = bless( {}, 'DBI::db' );
  
  L<Data::Printer> makes it better, but only to debug the class itself,
  not helpful at all to see its contents and debug your own code:
  
      DBI::db  {
          Parents       DBI::common
          Linear @ISA   DBI::db, DBI::common
          public methods (48) : begin_work, clone, column_info, commit, connected, data_sources, disconnect, do, foreign_key_info, get_info, last_insert_id, ping, prepare, prepare_cached, preparse, primary_key, primary_key_info, quote, quote_identifier, rollback, rows, selectall_arrayref, selectall_hashref, selectcol_arrayref, selectrow_array, selectrow_arrayref, selectrow_hashref, sqlite_backup_from_file, sqlite_backup_to_file, sqlite_busy_timeout, sqlite_collation_needed, sqlite_commit_hook, sqlite_create_aggregate, sqlite_create_collation, sqlite_create_function, sqlite_enable_load_extension, sqlite_last_insert_rowid, sqlite_progress_handler, sqlite_register_fts3_perl_tokenizer, sqlite_rollback_hook, sqlite_set_authorizer, sqlite_update_hook, statistics_info, table_info, tables, take_imp_data, type_info, type_info_all
          private methods (0)
          internals: {
          }
      }
  
  Fear no more! If you use this filter, here's what you'll see:
  
      SQLite Database Handle (connected) {
          dbname: file.db
          Auto Commit: 1
          Statement Handles: 0
          Last Statement: -
      }
  
  Much better, huh? :)
  
  Statement handlers are even better. Imagine you continued your code with something like:
  
    my $sth = $dbh->prepare('SELECT * FROM foo WHERE bar = ?');
    $sth->execute(42);
  
  With this filter, instead of an empty dump or full method information, you'll get
  exactly what you came for:
  
   SELECT * FROM foo WHERE bar = ?  (42)
  
  Note that if your driver does not support holding of parameter values, you'll get a
  C<bindings unavailable> message instead of the bound values.
  
  
  =head1 SEE ALSO
  
  L<Data::Printer>
  
  
DATA_PRINTER_FILTER_DB

$fatpacked{"Data/Printer/Filter/DateTime.pm"} = <<'DATA_PRINTER_FILTER_DATETIME';
  package Data::Printer::Filter::DateTime;
  use strict;
  use warnings;
  use Data::Printer::Filter;
  use Term::ANSIColor;
  
  filter 'Time::Piece', sub {
      return _format($_[0]->cdate, @_ );
  };
  
  filter 'DateTime', sub {
      my ($obj, $p) = @_;
      my $string = "$obj";
      if ( not exists $p->{datetime}{show_timezone} or $p->{datetime}{show_timezone} ) {
          $string .= ' [' . $obj->time_zone->name . ']';
      }
      return _format( $string, @_ );
  };
  
  # DateTime::TimeZone filters
  filter '-class' => sub {
      my ($obj, $properties) = @_;
  
      if ( $obj->isa('DateTime::TimeZone' ) ) {
          return $obj->name;
      }
      else {
          return;
      }
  };
  
  filter 'DateTime::Incomplete', sub {
      return _format( $_[0]->iso8601, @_ );
  };
  
  filter 'DateTime::Duration', sub {
      my ($object, $p) = @_;
  
      my @dur = $object->in_units(
           qw(years months days hours minutes seconds)
      );
  
      my $string = "$dur[0]y $dur[1]m $dur[2]d $dur[3]h $dur[4]m $dur[5]s";
  
      return _format( $string, @_ );
  };
  
  filter 'DateTime::Tiny', sub {
      return _format( $_[0]->as_string, @_ );
  };
  
  filter 'Class::Date', sub {
      my ($object, $p) = @_;
  
      my $string = $object->strftime("%Y-%m-%d %H:%M:%S") .  " [" . $object->tzdst . "]";
  
      return _format( $string, @_ );
  };
  
  filter 'Date::Calc::Object', sub {
      return _format( $_[0]->string(2), @_ );
  };
  
  filter 'Date::Pcalc::Object', sub {
      return _format( $_[0]->string(2), @_ );
  };
  
  filter 'Date::Handler', sub {
      return _format( "$_[0]", @_ );
  };
  
  filter 'Date::Handler::Delta', sub {
      return _format( $_[0]->AsScalar, @_ );
  };
  
  
  sub _format {
      my ($str, $obj, $p) = @_;
  
      if ( $p->{datetime}{show_class_name} ) {
          $str .= ' (' . ref($obj) . ')';
      }
  
      my $color = $p->{color}{datetime};
      $color = 'bright_green' unless defined $color;
  
      return colored( $str, $color );
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  Data::Printer::Filter::DateTime - pretty-printing date and time objects (not just DateTime!)
  
  =head1 SYNOPSIS
  
  In your program:
  
    use Data::Printer filters => {
      -external => [ 'DateTime' ],
    };
  
  or, in your C<.dataprinter> file:
  
    {
      filters => {
         -external => [ 'DateTime' ],
      },
    };
  
  You can also setup color and display details:
  
    use Data::Printer
        filters => {
            -external => [ 'DateTime' ],
        },
        color   => {
            datetime => 'bright_green',
        }
        datetime => {
            show_class_name => 1,  # default is 0
            show_timezone   => 0,  # default is 1 (only works for DateTime objects)
        },
    };
  
  =head1 DESCRIPTION
  
  This is a filter plugin for L<Data::Printer>. It filters through
  several date and time manipulation classes and displays the time
  (or time duration) as a string.
  
  =head2 Parsed Modules
  
  =over 4
  
  =item * L<DateTime>
  
  =item * L<DateTime::Duration>
  
  =item * L<DateTime::Incomplete>
  
  =item * L<Class::Date>
  
  =item * L<Time::Piece>
  
  =item * L<Date::Handler>
  
  =item * L<Date::Handler::Delta>
  
  =item * L<Date::Calc::Object>
  
  =item * L<Date::Pcalc::Object>
  
  =back
  
  If you have any suggestions for more modules or better output,
  please let us know.
  
  
  =head1 SEE ALSO
  
  L<Data::Printer>
  
  
DATA_PRINTER_FILTER_DATETIME

$fatpacked{"Data/Printer/Filter/Digest.pm"} = <<'DATA_PRINTER_FILTER_DIGEST';
  package Data::Printer::Filter::Digest;
  use strict;
  use warnings;
  use Data::Printer::Filter;
  use Term::ANSIColor;
  
  foreach my $digest ( qw( Digest::MD2 Digest::MD4 Digest::Haval256)) {
      filter $digest => \&_print_digest;
  }
  
  filter '-class', sub {
    my ($obj, $p) = @_;
    return unless $obj->isa( 'Digest::base' );
    return _print_digest( $obj, $p );
  };
  
  
  sub _print_digest {
    my ($obj, $p) = @_;
    my $digest = $obj->clone->hexdigest;
    my $str = $digest;
    my $ref = ref $obj;
  
    if ( $p->{digest}{show_class_name} ) {
        $str .= " ($ref)";
    }
  
    unless ( exists  $p->{digest}{show_reset}
                and !$p->{digest}{show_reset}
     ) {
       if ($digest eq $ref->new->hexdigest) {
           $str .= ' [reset]';
       }
    }
  
    my $color = $p->{color}{digest};
    $color = 'bright_green' unless defined $color;
  
    return colored( $str, $color );
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  Data::Printer::Filter::Digest - pretty-printing MD5, SHA and friends
  
  =head1 SYNOPSIS
  
  In your program:
  
    use Data::Printer filters => {
      -external => [ 'Digest' ],
    };
  
  or, in your C<.dataprinter> file:
  
    {
      filters => {
         -external => [ 'Digest' ],
      },
    };
  
  You can also setup color and display details:
  
    use Data::Printer
        filters => {
            -external => [ 'Digest' ],
        },
        color   => {
            digest => 'bright_green',
        }
        digest => {
            show_class_name => 0,  # default.
            show_reset      => 1,  # default.
        },
    };
  
  =head1 DESCRIPTION
  
  This is a filter plugin for L<Data::Printer>. It filters through
  several digest classes and displays their current value in
  hexadecimal format as a string.
  
  =head2 Parsed Modules
  
  =over 4
  
  =item * L<Digest::Adler32>
  
  =item * L<Digest::MD2>
  
  =item * L<Digest::MD4>
  
  =item * L<Digest::MD5>
  
  =item * L<Digest::SHA>
  
  =item * L<Digest::SHA1>
  
  =item * L<Digest::Whirlpool>
  
  =item * L<Digest::Haval256>
  
  =back
  
  If you have any suggestions for more modules or better output,
  please let us know.
  
  =head2 Extra Options
  
  Aside from the display color, there are a few other options to
  be customized via the C<digest> option key:
  
  =head3 show_class_name
  
  Set this to true to display the class name right next to the
  hexadecimal digest. Default is 0 (false).
  
  =head3 show_reset
  
  If set to true (the default), the filter will add a C<[reset]>
  tag after dumping an empty digest object. See the rationale below.
  
  =head2 Note on dumping Digest::* objects
  
  The digest operation is effectively a destructive, read-once operation. Once it has been performed, most Digest::* objects are automatically reset and can be used to calculate another digest value.
  
  This behaviour - or, rather, forgetting about this behaviour - is
  a common source of issues when working with Digests.
  
  This Data::Printer filter will B<not> destroy your object. Instead, we work on a cloned version to display the hexdigest, leaving your
  original object untouched.
  
  As another debugging convenience for developers, since the empty
  object will produce a digest even after being used, this filter
  adds by default a C<[reset]> tag to indicate that the object is
  empty, in a 'reset' state - i.e. its hexdigest is the same as
  the hexdigest of a new, empty object of that same class.
  
  =head1 SEE ALSO
  
  L<Data::Printer>
  
  
DATA_PRINTER_FILTER_DIGEST

$fatpacked{"File/HomeDir.pm"} = <<'FILE_HOMEDIR';
  package File::HomeDir;
  
  # See POD at end for documentation
  
  use 5.00503;
  use strict;
  use Carp        ();
  use Config      ();
  use File::Spec  ();
  use File::Which ();
  
  # Globals
  use vars qw{$VERSION @ISA @EXPORT @EXPORT_OK $IMPLEMENTED_BY};
  BEGIN {
  	$VERSION = '0.99';
  
  	# Inherit manually
  	require Exporter;
  	@ISA       = qw{ Exporter };
  	@EXPORT    = qw{ home     };
  	@EXPORT_OK = qw{
  		home
  		my_home
  		my_desktop
  		my_documents
  		my_music
  		my_pictures
  		my_videos
  		my_data
  		my_dist_config
  		my_dist_data
  		users_home
  		users_desktop
  		users_documents
  		users_music
  		users_pictures
  		users_videos
  		users_data
  	};
  
  	# %~ doesn't need (and won't take) exporting, as it's a magic
  	# symbol name that's always looked for in package 'main'.
  }
  
  # Inlined Params::Util functions
  sub _CLASS ($) {
  	(defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s) ? $_[0] : undef;
  }
  sub _DRIVER ($$) {
  	(defined _CLASS($_[0]) and eval "require $_[0];" and ! $@ and $_[0]->isa($_[1]) and $_[0] ne $_[1]) ? $_[0] : undef;
  }
  
  # Platform detection
  if ( $IMPLEMENTED_BY ) {
  	# Allow for custom HomeDir classes
  	# Leave it as the existing value
  } elsif ( $^O eq 'MSWin32' ) {
  	# All versions of Windows
  	$IMPLEMENTED_BY = 'File::HomeDir::Windows';
  } elsif ( $^O eq 'darwin') {
  	# 1st: try Mac::SystemDirectory by chansen
  	if ( eval { require Mac::SystemDirectory; 1 } ) {
  		$IMPLEMENTED_BY = 'File::HomeDir::Darwin::Cocoa';
  	} elsif ( eval { require Mac::Files; 1 } ) {
  		# 2nd try Mac::Files: Carbon - unmaintained since 2006 except some 64bit fixes
  		$IMPLEMENTED_BY = 'File::HomeDir::Darwin::Carbon';
  	} else {
  		# 3rd: fallback: pure perl
  		$IMPLEMENTED_BY = 'File::HomeDir::Darwin';
  	}
  } elsif ( $^O eq 'MacOS' ) {
  	# Legacy Mac OS
  	$IMPLEMENTED_BY = 'File::HomeDir::MacOS9';
  } elsif ( File::Which::which('xdg-user-dir') ) {
  	# freedesktop unixes
  	$IMPLEMENTED_BY = 'File::HomeDir::FreeDesktop';
  } else {
  	# Default to Unix semantics
  	$IMPLEMENTED_BY = 'File::HomeDir::Unix';
  }
  unless ( _DRIVER($IMPLEMENTED_BY, 'File::HomeDir::Driver') ) {
  	Carp::croak("Missing or invalid File::HomeDir driver $IMPLEMENTED_BY");
  }
  
  
  
  
  
  #####################################################################
  # Current User Methods
  
  sub my_home {
  	$IMPLEMENTED_BY->my_home;
  }
  
  sub my_desktop {
  	$IMPLEMENTED_BY->can('my_desktop')
  		? $IMPLEMENTED_BY->my_desktop
  		: Carp::croak("The my_desktop method is not implemented on this platform");
  }
  
  sub my_documents {
  	$IMPLEMENTED_BY->can('my_documents')
  		? $IMPLEMENTED_BY->my_documents
  		: Carp::croak("The my_documents method is not implemented on this platform");
  }
  
  sub my_music {
  	$IMPLEMENTED_BY->can('my_music')
  		? $IMPLEMENTED_BY->my_music
  		: Carp::croak("The my_music method is not implemented on this platform");
  }
  
  sub my_pictures {
  	$IMPLEMENTED_BY->can('my_pictures')
  		? $IMPLEMENTED_BY->my_pictures
  		: Carp::croak("The my_pictures method is not implemented on this platform");
  }
  
  sub my_videos {
  	$IMPLEMENTED_BY->can('my_videos')
  		? $IMPLEMENTED_BY->my_videos
  		: Carp::croak("The my_videos method is not implemented on this platform");
  }
  
  sub my_data {
  	$IMPLEMENTED_BY->can('my_data')
  		? $IMPLEMENTED_BY->my_data
  		: Carp::croak("The my_data method is not implemented on this platform");
  }
  
  
  sub my_dist_data {
  	my $params = ref $_[-1] eq 'HASH' ? pop : {};
  	my $dist   = pop or Carp::croak("The my_dist_data method requires an argument");
  	my $data   = my_data();
  
          # If datadir is not defined, there's nothing we can do: bail out
          # and return nothing...	
  	return undef unless defined $data;
  
          # On traditional unixes, hide the top-level directory
  	my $var = $data eq home()
  		? File::Spec->catdir( $data, '.perl', 'dist', $dist )
  		: File::Spec->catdir( $data, 'Perl',  'dist', $dist );
  
  	# directory exists: return it
  	return $var if -d $var;
  
  	# directory doesn't exist: check if we need to create it...
  	return undef unless $params->{create};
  
  	# user requested directory creation
  	require File::Path;
  	File::Path::mkpath( $var );
  	return $var;
  }
  
  sub my_dist_config {
  	my $params = ref $_[-1] eq 'HASH' ? pop : {};
  	my $dist   = pop or Carp::croak("The my_dist_config method requires an argument");
  
  	# not all platforms support a specific my_config() method
  	my $config = $IMPLEMENTED_BY->can('my_config')
  		? $IMPLEMENTED_BY->my_config
  		: $IMPLEMENTED_BY->my_documents;
  
  	# If neither configdir nor my_documents is defined, there's
  	# nothing we can do: bail out and return nothing...	
  	return undef unless defined $config;
  
  	# On traditional unixes, hide the top-level dir
  	my $etc = $config eq home()
  		? File::Spec->catdir( $config, '.perl', $dist )
  		: File::Spec->catdir( $config, 'Perl',  $dist );
  
  	# directory exists: return it
  	return $etc if -d $etc;
  
  	# directory doesn't exist: check if we need to create it...
  	return undef unless $params->{create};
  
  	# user requested directory creation
  	require File::Path;
  	File::Path::mkpath( $etc );
  	return $etc;
  }
  
  
  
  
  #####################################################################
  # General User Methods
  
  sub users_home {
  	$IMPLEMENTED_BY->can('users_home')
  		? $IMPLEMENTED_BY->users_home( $_[-1] )
  		: Carp::croak("The users_home method is not implemented on this platform");
  }
  
  sub users_desktop {
  	$IMPLEMENTED_BY->can('users_desktop')
  		? $IMPLEMENTED_BY->users_desktop( $_[-1] )
  		: Carp::croak("The users_desktop method is not implemented on this platform");
  }
  
  sub users_documents {
  	$IMPLEMENTED_BY->can('users_documents')
  		? $IMPLEMENTED_BY->users_documents( $_[-1] )
  		: Carp::croak("The users_documents method is not implemented on this platform");
  }
  
  sub users_music {
  	$IMPLEMENTED_BY->can('users_music')
  		? $IMPLEMENTED_BY->users_music( $_[-1] )
  		: Carp::croak("The users_music method is not implemented on this platform");
  }
  
  sub users_pictures {
  	$IMPLEMENTED_BY->can('users_pictures')
  		? $IMPLEMENTED_BY->users_pictures( $_[-1] )
  		: Carp::croak("The users_pictures method is not implemented on this platform");
  }
  
  sub users_videos {
  	$IMPLEMENTED_BY->can('users_videos')
  		? $IMPLEMENTED_BY->users_videos( $_[-1] )
  		: Carp::croak("The users_videos method is not implemented on this platform");
  }
  
  sub users_data {
  	$IMPLEMENTED_BY->can('users_data')
  		? $IMPLEMENTED_BY->users_data( $_[-1] )
  		: Carp::croak("The users_data method is not implemented on this platform");
  }
  
  
  
  
  
  #####################################################################
  # Legacy Methods
  
  # Find the home directory of an arbitrary user
  sub home (;$) {
  	# Allow to be called as a method
  	if ( $_[0] and $_[0] eq 'File::HomeDir' ) {
  		shift();
  	}
  
  	# No params means my home
  	return my_home() unless @_;
  
  	# Check the param
  	my $name = shift;
  	if ( ! defined $name ) {
  		Carp::croak("Can't use undef as a username");
  	}
  	if ( ! length $name ) {
  		Carp::croak("Can't use empty-string (\"\") as a username");
  	}
  
  	# A dot also means my home
  	### Is this meant to mean File::Spec->curdir?
  	if ( $name eq '.' ) {
  		return my_home();
  	}
  
  	# Now hand off to the implementor
  	$IMPLEMENTED_BY->users_home($name);
  }
  
  
  
  
  
  #####################################################################
  # Tie-Based Interface
  
  # Okay, things below this point get scary
  
  CLASS: {
  	# Make the class for the %~ tied hash:
  	package File::HomeDir::TIE;
  
  	# Make the singleton object.
  	# (We don't use the hash for anything, though)
  	### THEN WHY MAKE IT???
  	my $SINGLETON = bless {};
  
  	sub TIEHASH { $SINGLETON }
  
  	sub FETCH {
  		# Catch a bad username
  		unless ( defined $_[1] ) {
  			Carp::croak("Can't use undef as a username");
  		}
  
  		# Get our homedir
  		unless ( length $_[1] ) {
  			return File::HomeDir::my_home();
  		}
  
  		# Get a named user's homedir
  		Carp::carp("The tied %~ hash has been deprecated");
  		return File::HomeDir::home($_[1]);
  	}
  
  	sub STORE    { _bad('STORE')    }
  	sub EXISTS   { _bad('EXISTS')   }
  	sub DELETE   { _bad('DELETE')   }
  	sub CLEAR    { _bad('CLEAR')    }
  	sub FIRSTKEY { _bad('FIRSTKEY') }
  	sub NEXTKEY  { _bad('NEXTKEY')  }
  
  	sub _bad ($) {
  		Carp::croak("You can't $_[0] with the %~ hash")
  	}
  }
  
  # Do the actual tie of the global %~ variable
  tie %~, 'File::HomeDir::TIE';
  
  1;
  
  __END__
  
  =pod
  
  =head1 NAME
  
  File::HomeDir - Find your home and other directories on any platform
  
  =head1 SYNOPSIS
  
    use File::HomeDir;
    
    # Modern Interface (Current User)
    $home     = File::HomeDir->my_home;
    $desktop  = File::HomeDir->my_desktop;
    $docs     = File::HomeDir->my_documents;
    $music    = File::HomeDir->my_music;
    $pics     = File::HomeDir->my_pictures;
    $videos   = File::HomeDir->my_videos;
    $data     = File::HomeDir->my_data;
    $dist     = File::HomeDir->my_dist_data('File-HomeDir');
    $dist     = File::HomeDir->my_dist_config('File-HomeDir');
    
    # Modern Interface (Other Users)
    $home    = File::HomeDir->users_home('foo');
    $desktop = File::HomeDir->users_desktop('foo');
    $docs    = File::HomeDir->users_documents('foo');
    $music   = File::HomeDir->users_music('foo');
    $pics    = File::HomeDir->users_pictures('foo');
    $video   = File::HomeDir->users_videos('foo');
    $data    = File::HomeDir->users_data('foo');
  
  =head1 DESCRIPTION
  
  B<File::HomeDir> is a module for locating the directories that are "owned"
  by a user (typicaly your user) and to solve the various issues that arise
  trying to find them consistently across a wide variety of platforms.
  
  The end result is a single API that can find your resources on any platform,
  making it relatively trivial to create Perl software that works elegantly
  and correctly no matter where you run it.
  
  This module provides two main interfaces.
  
  The first is a modern L<File::Spec>-style interface with a consistent
  OO API and different implementation modules to support various
  platforms. You are B<strongly> recommended to use this interface.
  
  The second interface is for legacy support of the original 0.07 interface
  that exported a C<home()> function by default and tied the C<%~> variable.
  
  It is generally not recommended that you use this interface, but due to
  back-compatibility reasons they will remain supported until at least 2010.
  
  The C<%~> interface has been deprecated. Documentation was removed in 2009,
  Unit test were removed in 2011, usage will issue warnings from 2013, and the
  interface will be removed entirely in 2015  (in line with the general Perl
  toolchain convention of a 10 year support period for legacy APIs that
  are potentially or actually in common use).
  
  =head2 Platform Neutrality
  
  In the Unix world, many different types of data can be mixed together
  in your home directory (although on some Unix platforms this is no longer
  the case, particularly for "desktop"-oriented platforms).
  
  On some non-Unix platforms, separate directories are allocated for
  different types of data and have been for a long time.
  
  When writing applications on top of B<File::HomeDir>, you should thus
  always try to use the most specific method you can. User documents should
  be saved in C<my_documents>, data that supports an application but isn't
  normally editing by the user directory should go into C<my_data>.
  
  On platforms that do not make any distinction, all these different
  methods will harmlessly degrade to the main home directory, but on
  platforms that care B<File::HomeDir> will always try to Do The Right
  Thing(tm).
  
  =head1 METHODS
  
  Two types of methods are provided. The C<my_method> series of methods for
  finding resources for the current user, and the C<users_method> (read as
  "user's method") series for finding resources for arbitrary users.
  
  This split is necessary, as on most platforms it is B<much> easier to find
  information about the current user compared to other users, and indeed
  on a number you cannot find out information such as C<users_desktop> at
  all, due to security restrictions.
  
  All methods will double check (using a C<-d> test) that a directory
  actually exists before returning it, so you may trust in the values
  that are returned (subject to the usual caveats of race conditions of
  directories being deleted at the moment between a directory being returned
  and you using it).
  
  However, because in some cases platforms may not support the concept of home
  directories at all, any method may return C<undef> (both in scalar and list
  context) to indicate that there is no matching directory on the system.
  
  For example, most untrusted 'nobody'-type users do not have a home
  directory. So any modules that are used in a CGI application that
  at some level of recursion use your code, will result in calls to
  File::HomeDir returning undef, even for a basic home() call.
  
  =head2 my_home
  
  The C<my_home> method takes no arguments and returns the main home/profile
  directory for the current user.
  
  If the distinction is important to you, the term "current" refers to the
  real user, and not the effective user.
  
  This is also the case for all of the other "my" methods.
  
  Returns the directory path as a string, C<undef> if the current user
  does not have a home directory, or dies on error.
  
  =head2 my_desktop
  
  The C<my_desktop> method takes no arguments and returns the "desktop"
  directory for the current user.
  
  Due to the diversity and complexity of implementions required to deal with
  implementing the required functionality fully and completely, the
  C<my_desktop> method may or may not be implemented on each platform.
  
  That said, I am extremely interested in code to implement C<my_desktop> on
  Unix, as long as it is capable of dealing (as the Windows implementation
  does) with internationalisation. It should also avoid false positive
  results by making sure it only returns the appropriate directories for the
  appropriate platforms.
  
  Returns the directory path as a string, C<undef> if the current user
  does not have a desktop directory, or dies on error.
  
  =head2 my_documents
  
  The C<my_documents> method takes no arguments and returns the directory (for
  the current user) where the user's documents are stored.
  
  Returns the directory path as a string, C<undef> if the current user
  does not have a documents directory, or dies on error.
  
  =head2 my_music
  
  The C<my_music> method takes no arguments and returns the directory
  where the current user's music is stored.
  
  No bias is made to any particular music type or music program, rather the
  concept of a directory to hold the user's music is made at the level of the
  underlying operating system or (at least) desktop environment.
  
  Returns the directory path as a string, C<undef> if the current user
  does not have a suitable directory, or dies on error.
  
  =head2 my_pictures
  
  The C<my_pictures> method takes no arguments and returns the directory
  where the current user's pictures are stored.
  
  No bias is made to any particular picture type or picture program, rather the
  concept of a directory to hold the user's pictures is made at the level of the
  underlying operating system or (at least) desktop environment.
  
  Returns the directory path as a string, C<undef> if the current user
  does not have a suitable directory, or dies on error.
  
  =head2 my_videos
  
  The C<my_videos> method takes no arguments and returns the directory
  where the current user's videos are stored.
  
  No bias is made to any particular video type or video program, rather the
  concept of a directory to hold the user's videos is made at the level of the
  underlying operating system or (at least) desktop environment.
  
  Returns the directory path as a string, C<undef> if the current user
  does not have a suitable directory, or dies on error.
  
  =head2 my_data
  
  The C<my_data> method takes no arguments and returns the directory where
  local applications should stored their internal data for the current
  user.
  
  Generally an application would create a subdirectory such as C<.foo>,
  beneath this directory, and store its data there. By creating your
  directory this way, you get an accurate result on the maximum number of
  platforms. But see the documentation about C<my_dist_config()> or
  C<my_dist_data()> below.
  
  For example, on Unix you get C<~/.foo> and on Win32 you get
  C<~/Local Settings/Application Data/.foo>
  
  Returns the directory path as a string, C<undef> if the current user
  does not have a data directory, or dies on error.
  
  
  =head2 my_dist_config
  
    File::HomeDir->my_dist_config( $dist [, \%params] );
    
    # For example...
    
    File::HomeDir->my_dist_config( 'File-HomeDir' );
    File::HomeDir->my_dist_config( 'File-HomeDir', { create => 1 } );
  
  The C<my_dist_config> method takes a distribution name as argument and
  returns an application-specific directory where they should store their
  internal configuration.
  
  The base directory will be either C<my_config> if the platform supports
  it, or C<my_documents> otherwise. The subdirectory itself will be 
  C<BASE/Perl/Dist-Name>. If the base directory is the user's homedir,
  C<my_dist_config> will be in C<~/.perl/Dist-Name> (and thus be hidden on
  all Unixes).
  
  The optional last argument is a hash reference to tweak the method
  behaviour. The following hash keys are recognized:
  
  =over 4
  
  =item * create
  
  Passing a true value to this key will force the creation of the
  directory if it doesn't exist (remember that C<File::HomeDir>'s policy
  is to return C<undef> if the directory doesn't exist).
  
  Defaults to false, meaning no automatic creation of directory.
  
  =back
  
  
  =head2 my_dist_data
  
    File::HomeDir->my_dist_data( $dist [, \%params] );
    
    # For example...
    
    File::HomeDir->my_dist_data( 'File-HomeDir' );
    File::HomeDir->my_dist_data( 'File-HomeDir', { create => 1 } );
  
  The C<my_dist_data> method takes a distribution name as argument and
  returns an application-specific directory where they should store their
  internal data.
  
  This directory will be of course a subdirectory of C<my_data>. Platforms
  supporting data-specific directories will use
  C<DATA_DIR/perl/dist/Dist-Name> following the common
  "DATA/vendor/application" pattern. If the C<my_data> directory is the
  user's homedir, C<my_dist_data> will be in C<~/.perl/dist/Dist-Name>
  (and thus be hidden on all Unixes).
  
  The optional last argument is a hash reference to tweak the method
  behaviour. The following hash keys are recognized:
  
  =over 4
  
  =item * create
  
  Passing a true value to this key will force the creation of the
  directory if it doesn't exist (remember that C<File::HomeDir>'s policy
  is to return C<undef> if the directory doesn't exist).
  
  Defaults to false, meaning no automatic creation of directory.
  
  =back
  
  =head2 users_home
  
    $home = File::HomeDir->users_home('foo');
  
  The C<users_home> method takes a single param and is used to locate the
  parent home/profile directory for an identified user on the system.
  
  While most of the time this identifier would be some form of user name,
  it is permitted to vary per-platform to support user ids or UUIDs as
  applicable for that platform.
  
  Returns the directory path as a string, C<undef> if that user
  does not have a home directory, or dies on error.
  
  =head2 users_documents
  
    $docs = File::HomeDir->users_documents('foo');
  
  Returns the directory path as a string, C<undef> if that user
  does not have a documents directory, or dies on error.
  
  =head2 users_data
  
    $data = File::HomeDir->users_data('foo');
  
  Returns the directory path as a string, C<undef> if that user
  does not have a data directory, or dies on error.
  
  =head1 FUNCTIONS
  
  =head2 home
  
    use File::HomeDir;
    $home = home();
    $home = home('foo');
    $home = File::HomeDir::home();
    $home = File::HomeDir::home('foo');
  
  The C<home> function is exported by default and is provided for
  compatibility with legacy applications. In new applications, you should
  use the newer method-based interface above.
  
  Returns the directory path to a named user's home/profile directory.
  
  If provided no param, returns the directory path to the current user's
  home/profile directory.
  
  =head1 TO DO
  
  =over 4
  
  =item * Become generally clearer on situations in which a user might not
  have a particular resource.
  
  =item * Add more granularity to Unix, and add support to VMS and other
  esoteric platforms, so we can consider going core.
  
  =item * Add consistent support for users_* methods 
  
  =back
  
  =head1 SUPPORT
  
  This module is stored in an Open Repository at the following address.
  
  L<http://svn.ali.as/cpan/trunk/File-HomeDir>
  
  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 guarantee that your issue will be addressed in the next
  release of the module.
  
  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=File-HomeDir>
  
  For other issues, for commercial enhancement or support, or to have your
  write access enabled for the repository, contact the author at the email
  address above.
  
  =head1 ACKNOWLEDGEMENTS
  
  The biggest acknowledgement must go to Chris Nandor, who wielded his
  legendary Mac-fu and turned my initial fairly ordinary Darwin
  implementation into something that actually worked properly everywhere,
  and then donated a Mac OS X license to allow it to be maintained properly.
  
  =head1 AUTHORS
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  Sean M. Burke E<lt>sburke@cpan.orgE<gt>
  
  Chris Nandor E<lt>cnandor@cpan.orgE<gt>
  
  Stephen Steneker E<lt>stennie@cpan.orgE<gt>
  
  =head1 SEE ALSO
  
  L<File::ShareDir>, L<File::HomeDir::Win32> (legacy)
  
  =head1 COPYRIGHT
  
  Copyright 2005 - 2012 Adam Kennedy.
  
  Some parts copyright 2000 Sean M. Burke.
  
  Some parts copyright 2006 Chris Nandor.
  
  Some parts copyright 2006 Stephen Steneker.
  
  Some parts copyright 2009-2011 Jérôme Quelin.
  
  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
FILE_HOMEDIR

$fatpacked{"File/HomeDir/Darwin.pm"} = <<'FILE_HOMEDIR_DARWIN';
  package File::HomeDir::Darwin;
  
  use 5.00503;
  use strict;
  use Cwd                 ();
  use Carp                ();
  use File::HomeDir::Unix ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '0.99';
  	@ISA     = 'File::HomeDir::Unix';
  }
  
  
  
  
  
  #####################################################################
  # Current User Methods
  
  sub my_home {
  	my $class = shift;
  
  	if ( exists $ENV{HOME} and defined $ENV{HOME} ) {
  		return $ENV{HOME};
  	}
  
  	my $home = (getpwuid($<))[7];
  	return $home if $home && -d $home;
  
  	return undef;
  }
  
  sub _my_home {
  	my($class, $path) = @_;
  	my $home = $class->my_home;
  	return undef unless defined $home;
  
  	my $folder = "$home/$path";
  	unless ( -d $folder ) {
  		# Make sure that symlinks resolve to directories.
  		return undef unless -l $folder;
  		my $dir = readlink $folder or return;
  		return undef unless -d $dir;
  	}
  
  	return Cwd::abs_path($folder);
  }
  
  sub my_desktop {
  	my $class = shift;
  	$class->_my_home('Desktop');
  }
  
  sub my_documents {
  	my $class = shift;
  	$class->_my_home('Documents');
  }
  
  sub my_data {
  	my $class = shift;
  	$class->_my_home('Library/Application Support');
  }
  
  sub my_music {
  	my $class = shift;
  	$class->_my_home('Music');
  }
  
  sub my_pictures {
  	my $class = shift;
  	$class->_my_home('Pictures');
  }
  
  sub my_videos {
  	my $class = shift;
  	$class->_my_home('Movies');
  }
  
  
  
  
  
  #####################################################################
  # Arbitrary User Methods
  
  sub users_home {
  	my $class = shift;
  	my $home  = $class->SUPER::users_home(@_);
  	return defined $home ? Cwd::abs_path($home) : undef;
  }
  
  sub users_desktop {
  	my ($class, $name) = @_;
  	return undef if $name eq 'root';
  	$class->_to_user( $class->my_desktop, $name );
  }
  
  sub users_documents {
  	my ($class, $name) = @_;
  	return undef if $name eq 'root';
  	$class->_to_user( $class->my_documents, $name );
  }
  
  sub users_data {
  	my ($class, $name) = @_;
  	$class->_to_user( $class->my_data, $name )
  	||
  	$class->users_home($name);
  }
  
  # cheap hack ... not entirely reliable, perhaps, but ... c'est la vie, since
  # there's really no other good way to do it at this time, that i know of -- pudge
  sub _to_user {
  	my ($class, $path, $name) = @_;
  	my $my_home    = $class->my_home;
  	my $users_home = $class->users_home($name);
  	defined $users_home or return undef;
  	$path =~ s/^\Q$my_home/$users_home/;
  	return $path;
  }
  
  1;
  
  =pod
  
  =head1 NAME
  
  File::HomeDir::Darwin - Find your home and other directories on Darwin (OS X)
  
  =head1 DESCRIPTION
  
  This module provides Mac OS X specific file path for determining
  common user directories in pure perl, by just using C<$ENV{HOME}>
  without Carbon nor Cocoa API calls. In normal usage this module will
  always be used via L<File::HomeDir>.
  
  =head1 SYNOPSIS
  
    use File::HomeDir;
    
    # Find directories for the current user
    $home    = File::HomeDir->my_home;      # /Users/mylogin
    $desktop = File::HomeDir->my_desktop;   # /Users/mylogin/Desktop
    $docs    = File::HomeDir->my_documents; # /Users/mylogin/Documents
    $music   = File::HomeDir->my_music;     # /Users/mylogin/Music
    $pics    = File::HomeDir->my_pictures;  # /Users/mylogin/Pictures
    $videos  = File::HomeDir->my_videos;    # /Users/mylogin/Movies
    $data    = File::HomeDir->my_data;      # /Users/mylogin/Library/Application Support
  
  =cut
FILE_HOMEDIR_DARWIN

$fatpacked{"File/HomeDir/Darwin/Carbon.pm"} = <<'FILE_HOMEDIR_DARWIN_CARBON';
  package File::HomeDir::Darwin::Carbon;
  
  # Basic implementation for the Dawin family of operating systems.
  # This includes (most prominently) Mac OS X.
  
  use 5.00503;
  use strict;
  use Cwd                   ();
  use Carp                  ();
  use File::HomeDir::Darwin ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '0.99';
  
  	# This is only a child class of the pure Perl darwin
  	# class so that we can do homedir detection of all three
  	# drivers at one via ->isa.
  	@ISA = 'File::HomeDir::Darwin';
  
  	# Load early if in a forking environment and we have
  	# prefork, or at run-time if not.
  	local $@;
  	eval "use prefork 'Mac::Files'";
  }
  
  
  
  
  
  #####################################################################
  # Current User Methods
  
  sub my_home {
  	my $class = shift;
  
  	# A lot of unix people and unix-derived tools rely on
  	# the ability to overload HOME. We will support it too
  	# so that they can replace raw HOME calls with File::HomeDir.
  	if ( exists $ENV{HOME} and defined $ENV{HOME} ) {
  		return $ENV{HOME};
  	}
  
  	require Mac::Files;
  	$class->_find_folder(
  		Mac::Files::kCurrentUserFolderType(),
  	);
  }
  
  sub my_desktop {
  	my $class = shift;
  
  	require Mac::Files;
  	$class->_find_folder(
  		Mac::Files::kDesktopFolderType(),
  	);
  }
  
  sub my_documents {
  	my $class = shift;
  
  	require Mac::Files;
  	$class->_find_folder(
  		Mac::Files::kDocumentsFolderType(),
  	);
  }
  
  sub my_data {
  	my $class = shift;
  
  	require Mac::Files;
  	$class->_find_folder(
  		Mac::Files::kApplicationSupportFolderType(),
  	);
  }
  
  sub my_music {
  	my $class = shift;
  
  	require Mac::Files;
  	$class->_find_folder(
  		Mac::Files::kMusicDocumentsFolderType(),
  	);
  }
  
  sub my_pictures {
  	my $class = shift;
  
  	require Mac::Files;
  	$class->_find_folder(
  		Mac::Files::kPictureDocumentsFolderType(),
  	);
  }
  
  sub my_videos {
  	my $class = shift;
  
  	require Mac::Files;
  	$class->_find_folder(
  		Mac::Files::kMovieDocumentsFolderType(),
  	);
  }
  
  sub _find_folder {
  	my $class = shift;
  	my $name  = shift;
  
  	require Mac::Files;
  	my $folder = Mac::Files::FindFolder(
  		Mac::Files::kUserDomain(),
  		$name,
  	);
  	return undef unless defined $folder;
  
  	unless ( -d $folder ) {
  		# Make sure that symlinks resolve to directories.
  		return undef unless -l $folder;
  		my $dir = readlink $folder or return;
  		return undef unless -d $dir;
  	}
  
  	return Cwd::abs_path($folder);
  }
  
  
  
  
  
  #####################################################################
  # Arbitrary User Methods
  
  sub users_home {
  	my $class = shift;
  	my $home  = $class->SUPER::users_home(@_);
  	return defined $home ? Cwd::abs_path($home) : undef;
  }
  
  # in theory this can be done, but for now, let's cheat, since the
  # rest is Hard
  sub users_desktop {
  	my ($class, $name) = @_;
  	return undef if $name eq 'root';
  	$class->_to_user( $class->my_desktop, $name );
  }
  
  sub users_documents {
  	my ($class, $name) = @_;
  	return undef if $name eq 'root';
  	$class->_to_user( $class->my_documents, $name );
  }
  
  sub users_data {
  	my ($class, $name) = @_;
  	$class->_to_user( $class->my_data, $name )
  	||
  	$class->users_home($name);
  }
  
  # cheap hack ... not entirely reliable, perhaps, but ... c'est la vie, since
  # there's really no other good way to do it at this time, that i know of -- pudge
  sub _to_user {
  	my ($class, $path, $name) = @_;
  	my $my_home    = $class->my_home;
  	my $users_home = $class->users_home($name);
  	defined $users_home or return undef;
  	$path =~ s/^\Q$my_home/$users_home/;
  	return $path;
  }
  
  1;
  
  =pod
  
  =head1 NAME
  
  File::HomeDir::Darwin - Find your home and other directories on Darwin (OS X)
  
  =head1 DESCRIPTION
  
  This module provides Darwin-specific implementations for determining
  common user directories.  In normal usage this module will always be
  used via L<File::HomeDir>.
  
  Note -- since this module requires Mac::Carbon and Mac::Carbon does
  not work with 64-bit perls, on such systems, File::HomeDir will try
  L<File::HomeDir::Darwin::Cocoa> and then fall back to the (pure Perl)
  L<File::HomeDir::Darwin>.
  
  =head1 SYNOPSIS
  
    use File::HomeDir;
  
    # Find directories for the current user
    $home    = File::HomeDir->my_home;      # /Users/mylogin
    $desktop = File::HomeDir->my_desktop;   # /Users/mylogin/Desktop
    $docs    = File::HomeDir->my_documents; # /Users/mylogin/Documents
    $music   = File::HomeDir->my_music;     # /Users/mylogin/Music
    $pics    = File::HomeDir->my_pictures;  # /Users/mylogin/Pictures
    $videos  = File::HomeDir->my_videos;    # /Users/mylogin/Movies
    $data    = File::HomeDir->my_data;      # /Users/mylogin/Library/Application Support
  
  =head1 TODO
  
  =over 4
  
  =item * Test with Mac OS (versions 7, 8, 9)
  
  =item * Some better way for users_* ?
  
  =back
FILE_HOMEDIR_DARWIN_CARBON

$fatpacked{"File/HomeDir/Darwin/Cocoa.pm"} = <<'FILE_HOMEDIR_DARWIN_COCOA';
  package File::HomeDir::Darwin::Cocoa;
  
  use 5.00503;
  use strict;
  use Cwd                   ();
  use Carp                  ();
  use File::HomeDir::Darwin ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '0.99';
  	@ISA     = 'File::HomeDir::Darwin';
  
  	# Load early if in a forking environment and we have
  	# prefork, or at run-time if not.
  	local $@;
  	eval "use prefork 'Mac::SystemDirectory'";
  }
  
  
  
  
  
  #####################################################################
  # Current User Methods
  
  sub my_home {
  	my $class = shift;
  
  	# A lot of unix people and unix-derived tools rely on
  	# the ability to overload HOME. We will support it too
  	# so that they can replace raw HOME calls with File::HomeDir.
  	if ( exists $ENV{HOME} and defined $ENV{HOME} ) {
  		return $ENV{HOME};
  	}
  
  	require Mac::SystemDirectory;
  	return Mac::SystemDirectory::HomeDirectory();
  }
  
  # from 10.4
  sub my_desktop {
  	my $class = shift;
  
  	require Mac::SystemDirectory;
  	eval {
  		$class->_find_folder(Mac::SystemDirectory::NSDesktopDirectory())
  	}
  	||
  	$class->SUPER::my_desktop;
  }
  
  # from 10.2
  sub my_documents {
  	my $class = shift;
  
  	require Mac::SystemDirectory;
  	eval {
  		$class->_find_folder(Mac::SystemDirectory::NSDocumentDirectory())
  	}
  	||
  	$class->SUPER::my_documents;
  }
  
  # from 10.4
  sub my_data {
  	my $class = shift;
  
  	require Mac::SystemDirectory;
  	eval {
  		$class->_find_folder(Mac::SystemDirectory::NSApplicationSupportDirectory())
  	}
  	||
  	$class->SUPER::my_data;
  }
  
  # from 10.6
  sub my_music {
  	my $class = shift;
  
  	require Mac::SystemDirectory;
  	eval {
  		$class->_find_folder(Mac::SystemDirectory::NSMusicDirectory())
  	}
  	||
  	$class->SUPER::my_music;
  }
  
  # from 10.6
  sub my_pictures {
  	my $class = shift;
  
  	require Mac::SystemDirectory;
  	eval {
  		$class->_find_folder(Mac::SystemDirectory::NSPicturesDirectory())
  	}
  	||
  	$class->SUPER::my_pictures;
  }
  
  # from 10.6
  sub my_videos {
  	my $class = shift;
  
  	require Mac::SystemDirectory;
  	eval {
  		$class->_find_folder(Mac::SystemDirectory::NSMoviesDirectory())
  	}
  	||
  	$class->SUPER::my_videos;
  }
  
  sub _find_folder {
  	my $class = shift;
  	my $name  = shift;
  
  	require Mac::SystemDirectory;
  	my $folder = Mac::SystemDirectory::FindDirectory($name);
  	return undef unless defined $folder;
  
  	unless ( -d $folder ) {
  		# Make sure that symlinks resolve to directories.
  		return undef unless -l $folder;
  		my $dir = readlink $folder or return;
  		return undef unless -d $dir;
  	}
  
  	return Cwd::abs_path($folder);
  }
  
  1;
  
  =pod
  
  =head1 NAME
  
  File::HomeDir::Darwin::Cocoa - Find your home and other directories on Darwin (OS X)
  
  =head1 DESCRIPTION
  
  This module provides Darwin-specific implementations for determining
  common user directories using Cocoa API through
  L<Mac::SystemDirectory>.  In normal usage this module will always be
  used via L<File::HomeDir>.
  
  Theoretically, this should return the same paths as both of the other
  Darwin drivers.
  
  Because this module requires L<Mac::SystemDirectory>, if the module
  is not installed, L<File::HomeDir> will fall back to L<File::HomeDir::Darwin>.
  
  =head1 SYNOPSIS
  
    use File::HomeDir;
    
    # Find directories for the current user
    $home    = File::HomeDir->my_home;      # /Users/mylogin
    $desktop = File::HomeDir->my_desktop;   # /Users/mylogin/Desktop
    $docs    = File::HomeDir->my_documents; # /Users/mylogin/Documents
    $music   = File::HomeDir->my_music;     # /Users/mylogin/Music
    $pics    = File::HomeDir->my_pictures;  # /Users/mylogin/Pictures
    $videos  = File::HomeDir->my_videos;    # /Users/mylogin/Movies
    $data    = File::HomeDir->my_data;      # /Users/mylogin/Library/Application Support
  
  =cut
FILE_HOMEDIR_DARWIN_COCOA

$fatpacked{"File/HomeDir/Driver.pm"} = <<'FILE_HOMEDIR_DRIVER';
  package File::HomeDir::Driver;
  
  # Abstract base class that provides no functionality,
  # but confirms the class is a File::HomeDir driver class.
  
  use 5.00503;
  use strict;
  use Carp ();
  
  use vars qw{$VERSION};
  BEGIN {
  	$VERSION = '0.99';
  }
  
  sub my_home {
  	Carp::croak("$_[0] does not implement compulsory method $_[1]");
  }
  
  1;
  
  =pod
  
  =head1 NAME
  
  File::HomeDir::Driver - Base class for all File::HomeDir drivers
  
  =head1 DESCRIPTION
  
  This module is the base class for all L<File::HomeDir> drivers, and must
  be inherited from to identify a class as a driver.
  
  It is primarily provided as a convenience for this specific identification
  purpose, as L<File::HomeDir> supports the specification of custom drivers
  and an C<-E<gt>isa> check is used during the loading of the driver.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 SEE ALSO
  
  L<File::HomeDir>
  
  =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
FILE_HOMEDIR_DRIVER

$fatpacked{"File/HomeDir/FreeDesktop.pm"} = <<'FILE_HOMEDIR_FREEDESKTOP';
  package File::HomeDir::FreeDesktop;
  
  # Specific functionality for unixes running free desktops
  # compatible with (but not using) File-BaseDir-0.03
  
  # See POD at the end of the file for more documentation.
  
  use 5.00503;
  use strict;
  use Carp                ();
  use File::Spec          ();
  use File::Which         ();
  use File::HomeDir::Unix ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '0.99';
  	@ISA     = 'File::HomeDir::Unix';
  }
  
  # xdg uses $ENV{XDG_CONFIG_HOME}/user-dirs.dirs to know where are the
  # various "my xxx" directories. That is a shell file. The official API
  # is the xdg-user-dir executable. It has no provision for assessing
  # the directories of a user that is different than the one we are
  # running under; the standard substitute user mechanisms are needed to
  # overcome this.
  
  my $xdgprog = File::Which::which('xdg-user-dir');
  
  sub _my {
  	# No quoting because input is hard-coded and only comes from this module
  	my $thingy = qx($xdgprog $_[1]);
  	chomp $thingy;
  	return $thingy;
  }
  
  # Simple stuff
  sub my_desktop   { shift->_my('DESKTOP')   }
  sub my_documents { shift->_my('DOCUMENTS') }
  sub my_music     { shift->_my('MUSIC')     }
  sub my_pictures  { shift->_my('PICTURES')  }
  sub my_videos    { shift->_my('VIDEOS')    }
  
  sub my_data {
  	$ENV{XDG_DATA_HOME}
  	or
  	File::Spec->catdir(
  		shift->my_home,
  		qw{ .local share }
  	);
  }
  
  sub my_config {
  	$ENV{XDG_CONFIG_HOME}
  	or
  	File::Spec->catdir(
  		shift->my_home,
  		qw{ .config }
  	);
  }
  
  # Custom locations (currently undocumented)
  sub my_download    { shift->_my('DOWNLOAD')    }
  sub my_publicshare { shift->_my('PUBLICSHARE') }
  sub my_templates   { shift->_my('TEMPLATES')   }
  
  sub my_cache {
      $ENV{XDG_CACHE_HOME}
      ||
      File::Spec->catdir(shift->my_home, qw{ .cache });
  }
  
  
  
  
  
  #####################################################################
  # General User Methods
  
  sub users_desktop   { Carp::croak('The users_desktop method is not available on an XDG based system.');   }
  sub users_documents { Carp::croak('The users_documents method is not available on an XDG based system.'); }
  sub users_music     { Carp::croak('The users_music method is not available on an XDG based system.');     }
  sub users_pictures  { Carp::croak('The users_pictures method is not available on an XDG based system.');  }
  sub users_videos    { Carp::croak('The users_videos method is not available on an XDG based system.');    }
  sub users_data      { Carp::croak('The users_data method is not available on an XDG based system.');      }
  
  1;
  
  =pod
  
  =head1 NAME
  
  File::HomeDir::FreeDesktop - Find your home and other directories on FreeDesktop.org Unix
  
  =head1 DESCRIPTION
  
  This module provides implementations for determining common user
  directories.  In normal usage this module will always be
  used via L<File::HomeDir>.
  
  =head1 SYNOPSIS
  
    use File::HomeDir;
    
    # Find directories for the current user
    $home    = File::HomeDir->my_home;        # /home/mylogin
    $desktop = File::HomeDir->my_desktop;
    $docs    = File::HomeDir->my_documents;
    $music   = File::HomeDir->my_music;
    $pics    = File::HomeDir->my_pictures;
    $videos  = File::HomeDir->my_videos;
    $data    = File::HomeDir->my_data;
  
  =head1 AUTHORS
  
  Jerome Quelin E<lt>jquellin@cpan.org<gt>
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 SEE ALSO
  
  L<File::HomeDir>, L<File::HomeDir::Win32> (legacy)
  
  =head1 COPYRIGHT
  
  Copyright 2009 - 2011 Jerome Quelin.
  
  Some parts copyright 2010 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
FILE_HOMEDIR_FREEDESKTOP

$fatpacked{"File/HomeDir/MacOS9.pm"} = <<'FILE_HOMEDIR_MACOS9';
  package File::HomeDir::MacOS9;
  
  # Half-assed implementation for the legacy Mac OS9 operating system.
  # Provided mainly to provide legacy compatibility. May be removed at
  # a later date.
  
  use 5.00503;
  use strict;
  use Carp                  ();
  use File::HomeDir::Driver ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '0.99';
  	@ISA     = 'File::HomeDir::Driver';
  }
  
  # Load early if in a forking environment and we have
  # prefork, or at run-time if not.
  SCOPE: {
  	local $@;
  	eval "use prefork 'Mac::Files'";
  }
  
  
  
  
  
  #####################################################################
  # Current User Methods
  
  sub my_home {
  	my $class = shift;
  
  	# Try for $ENV{HOME} if we have it
  	if ( defined $ENV{HOME} ) {
  		return $ENV{HOME};
  	}
  
  	### DESPERATION SETS IN
  
  	# We could use the desktop
  	SCOPE: {
  		local $@;
  		eval {
  			my $home = $class->my_desktop;
  			return $home if $home and -d $home;
  		};
  	}
  
  	# Desperation on any platform
  	SCOPE: {
  		# On some platforms getpwuid dies if called at all
  		local $SIG{'__DIE__'} = '';
  		my $home = (getpwuid($<))[7];
  		return $home if $home and -d $home;
  	}
  
  	Carp::croak("Could not locate current user's home directory");
  }
  
  sub my_desktop {
  	my $class = shift;
  
  	# Find the desktop via Mac::Files
  	local $SIG{'__DIE__'} = '';
  	require Mac::Files;
  	my $home = Mac::Files::FindFolder(
  		Mac::Files::kOnSystemDisk(),
  		Mac::Files::kDesktopFolderType(),
  		);
  	return $home if $home and -d $home;
  
  	Carp::croak("Could not locate current user's desktop");
  }
  
  
  
  
  
  #####################################################################
  # General User Methods
  
  sub users_home {
  	my ($class, $name) = @_;
  
  	SCOPE: {
  		# On some platforms getpwnam dies if called at all
  		local $SIG{'__DIE__'} = '';
  		my $home = (getpwnam($name))[7];
  		return $home if defined $home and -d $home;
  	}
  
  	Carp::croak("Failed to find home directory for user '$name'");
  }
  
  1;
  
  =pod
  
  =head1 NAME
  
  File::HomeDir::MacOS9 - Find your home and other directories on legacy Macs
  
  =head1 SYNOPSIS
  
    use File::HomeDir;
    
    # Find directories for the current user
    $home    = File::HomeDir->my_home;
    $desktop = File::HomeDir->my_desktop;
  
  =head1 DESCRIPTION
  
  This module provides implementations for determining common user
  directories on legacy Mac hosts. In normal usage this module will always be
  used via L<File::HomeDir>.
  
  This module is no longer actively maintained, and is included only for
  extreme back-compatibility.
  
  Only the C<my_home> and C<my_desktop> methods are supported.
  
  =head1 SUPPORT
  
  See the support section the main L<File::HomeDir> module.
  
  =head1 AUTHORS
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  Sean M. Burke E<lt>sburke@cpan.orgE<gt>
  
  =head1 SEE ALSO
  
  L<File::HomeDir>
  
  =head1 COPYRIGHT
  
  Copyright 2005 - 2011 Adam Kennedy.
  
  Some parts copyright 2000 Sean M. Burke.
  
  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
FILE_HOMEDIR_MACOS9

$fatpacked{"File/HomeDir/Test.pm"} = <<'FILE_HOMEDIR_TEST';
  package File::HomeDir::Test;
  
  use 5.00503;
  use strict;
  use Carp                  ();
  use File::Spec            ();
  use File::Temp            ();
  use File::HomeDir::Driver ();
  
  use vars qw{$VERSION @ISA %DIR $ENABLED};
  BEGIN {
  	$VERSION = '0.99';
  	@ISA     = 'File::HomeDir::Driver';
  	%DIR     = ();
  	$ENABLED = 0;
  }
  
  # Special magic use in test scripts
  sub import {
  	my $class = shift;
  	die "Attempted to initialise File::HomeDir::Test trice" if %DIR;
  
  	# Fill the test directories
  	my $BASE  = File::Temp::tempdir( CLEANUP => 1 );
  	%DIR = map { $_ => File::Spec->catdir( $BASE, $_ ) } qw{
  		my_home
  		my_desktop
  		my_documents
  		my_data
  		my_music
  		my_pictures
  		my_videos
  	};
  
  	# Hijack HOME to the home directory
  	$ENV{HOME} = $DIR{my_home};
  
  	# Make File::HomeDir load us instead of the native driver
  	$File::HomeDir::IMPLEMENTED_BY = # Prevent a warning
  	$File::HomeDir::IMPLEMENTED_BY = 'File::HomeDir::Test';
  
  	# Ready to go
  	$ENABLED = 1;
  }
  
  
  
  
  
  #####################################################################
  # Current User Methods
  
  sub my_home {
  	mkdir($DIR{my_home}, 0755) unless -d $DIR{my_home};
  	return $DIR{my_home};
  }
  
  sub my_desktop {
  	mkdir($DIR{my_desktop}, 0755) unless -d $DIR{my_desktop};
  	return $DIR{my_desktop};
  }
  
  sub my_documents {
  	mkdir($DIR{my_documents}, 0755) unless -f $DIR{my_documents};
  	return $DIR{my_documents};
  }
  
  sub my_data {
  	mkdir($DIR{my_data}, 0755) unless -d $DIR{my_data};
  	return $DIR{my_data};
  }
  
  sub my_music {
  	mkdir($DIR{my_music}, 0755) unless -d $DIR{my_music};
  	return $DIR{my_music};
  }
  
  sub my_pictures {
  	mkdir($DIR{my_pictures}, 0755) unless -d $DIR{my_pictures};
  	return $DIR{my_pictures};
  }
  
  sub my_videos {
  	mkdir($DIR{my_videos}, 0755) unless -d $DIR{my_videos};
  	return $DIR{my_videos};
  }
  
  sub users_home {
  	return undef;
  }
  
  1;
  
  __END__
  
  =pod
  
  =head1 NAME
  
  File::HomeDir::Test - Prevent the accidental creation of user-owned files during testing
  
  =head1 SYNOPSIS
  
    use Test::More test => 1;
    use File::HomeDir::Test;
    use File::HomeDir;
  
  =head1 DESCRIPTION
  
  B<File::HomeDir::Test> is a L<File::HomeDir> driver intended for use in the test scripts
  of modules or applications that write files into user-owned directories.
  
  It is designed to prevent the pollution of user directories with files that are not part
  of the application install itself, but were created during testing. These files can leak
  state information from the tests into the run-time usage of an application, and on Unix
  systems also prevents tests (which may be executed as root via sudo) from writing files
  which cannot later be modified or removed by the regular user.
  
  =head1 SUPPORT
  
  See the support section of the main L<File::HomeDir> documentation.
  
  =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
FILE_HOMEDIR_TEST

$fatpacked{"File/HomeDir/Unix.pm"} = <<'FILE_HOMEDIR_UNIX';
  package File::HomeDir::Unix;
  
  # See POD at the end of the file for documentation
  
  use 5.00503;
  use strict;
  use Carp                  ();
  use File::HomeDir::Driver ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '0.99';
  	@ISA     = 'File::HomeDir::Driver';
  }
  
  
  
  
  
  #####################################################################
  # Current User Methods
  
  sub my_home {
  	my $class = shift;
  	my $home  = $class->_my_home(@_);
  
  	# On Unix in general, a non-existant home means "no home"
  	# For example, "nobody"-like users might use /nonexistant
  	if ( defined $home and ! -d $home ) {
  		$home = undef;
  	}
  
  	return $home;
  }
  
  sub _my_home {
  	my $class = shift;
  	if ( exists $ENV{HOME} and defined $ENV{HOME} ) {
  		return $ENV{HOME};
  	}
  
  	# This is from the original code, but I'm guessing
  	# it means "login directory" and exists on some Unixes.
  	if ( exists $ENV{LOGDIR} and $ENV{LOGDIR} ) {
  		return $ENV{LOGDIR};
  	}
  
  	### More-desperate methods
  
  	# Light desperation on any (Unixish) platform
  	SCOPE: {
  		my $home = (getpwuid($<))[7];
  		return $home if $home and -d $home;
  	}
  
  	return undef;
  }
  
  # On unix by default, everything is under the same folder
  sub my_desktop {
  	shift->my_home;
  }
  
  sub my_documents {
  	shift->my_home;
  }
  
  sub my_data {
  	shift->my_home;
  }
  
  sub my_music {
  	shift->my_home;
  }
  
  sub my_pictures {
  	shift->my_home;
  }
  
  sub my_videos {
  	shift->my_home;
  }
  
  
  
  
  
  #####################################################################
  # General User Methods
  
  sub users_home {
  	my ($class, $name) = @_;
  
  	# IF and only if we have getpwuid support, and the
  	# name of the user is our own, shortcut to my_home.
  	# This is needed to handle HOME environment settings.
  	if ( $name eq getpwuid($<) ) {
  		return $class->my_home;
  	}
  
  	SCOPE: {
  		my $home = (getpwnam($name))[7];
  		return $home if $home and -d $home;
  	}
  
  	return undef;
  }
  
  sub users_desktop {
  	shift->users_home(@_);
  }
  
  sub users_documents {
  	shift->users_home(@_);
  }
  
  sub users_data {
  	shift->users_home(@_);
  }
  
  sub users_music {
  	shift->users_home(@_);
  }
  
  sub users_pictures {
  	shift->users_home(@_);
  }
  
  sub users_videos {
  	shift->users_home(@_);
  }
  
  1;
  
  =pod
  
  =head1 NAME
  
  File::HomeDir::Unix - Find your home and other directories on legacy Unix
  
  =head1 SYNOPSIS
  
    use File::HomeDir;
    
    # Find directories for the current user
    $home    = File::HomeDir->my_home;        # /home/mylogin
    $desktop = File::HomeDir->my_desktop;     # All of these will... 
    $docs    = File::HomeDir->my_documents;   # ...default to home...
    $music   = File::HomeDir->my_music;       # ...directory
    $pics    = File::HomeDir->my_pictures;    #
    $videos  = File::HomeDir->my_videos;      #
    $data    = File::HomeDir->my_data;        # 
  
  =head1 DESCRIPTION
  
  This module provides implementations for determining common user
  directories.  In normal usage this module will always be
  used via L<File::HomeDir>.
  
  =head1 SUPPORT
  
  See the support section the main L<File::HomeDir> module.
  
  =head1 AUTHORS
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  Sean M. Burke E<lt>sburke@cpan.orgE<gt>
  
  =head1 SEE ALSO
  
  L<File::HomeDir>, L<File::HomeDir::Win32> (legacy)
  
  =head1 COPYRIGHT
  
  Copyright 2005 - 2011 Adam Kennedy.
  
  Some parts copyright 2000 Sean M. Burke.
  
  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
FILE_HOMEDIR_UNIX

$fatpacked{"File/HomeDir/Windows.pm"} = <<'FILE_HOMEDIR_WINDOWS';
  package File::HomeDir::Windows;
  
  # See POD at the end of the file for documentation
  
  use 5.00503;
  use strict;
  use Carp                  ();
  use File::Spec            ();
  use File::HomeDir::Driver ();
  
  use vars qw{$VERSION @ISA};
  BEGIN {
  	$VERSION = '0.99';
  	@ISA     = 'File::HomeDir::Driver';
  }
  
  sub CREATE () { 1 }
  
  
  
  
  
  #####################################################################
  # Current User Methods
  
  sub my_home {
  	my $class = shift;
  
  	# A lot of unix people and unix-derived tools rely on
  	# the ability to overload HOME. We will support it too
  	# so that they can replace raw HOME calls with File::HomeDir.
  	if ( exists $ENV{HOME} and $ENV{HOME} ) {
  		return $ENV{HOME};
  	}
  
  	# Do we have a user profile?
  	if ( exists $ENV{USERPROFILE} and $ENV{USERPROFILE} ) {
  		return $ENV{USERPROFILE};
  	}
  
  	# Some Windows use something like $ENV{HOME}
  	if ( exists $ENV{HOMEDRIVE} and exists $ENV{HOMEPATH} and $ENV{HOMEDRIVE} and $ENV{HOMEPATH} ) {
  		return File::Spec->catpath(
  			$ENV{HOMEDRIVE}, $ENV{HOMEPATH}, '',
  		);
  	}
  
  	return undef;
  }
  
  sub my_desktop {
  	my $class = shift;
  
  	# The most correct way to find the desktop
  	SCOPE: {
  		require Win32;
  		my $dir = Win32::GetFolderPath(Win32::CSIDL_DESKTOP(), CREATE);
  		return $dir if $dir and $class->_d($dir);
  	}
  
  	# MSWindows sets WINDIR, MS WinNT sets USERPROFILE.
  	foreach my $e ( 'USERPROFILE', 'WINDIR' ) {
  		next unless $ENV{$e};
  		my $desktop = File::Spec->catdir($ENV{$e}, 'Desktop');
  		return $desktop if $desktop and $class->_d($desktop);
  	}
  
  	# As a last resort, try some hard-wired values
  	foreach my $fixed (
  		# The reason there are both types of slash here is because
  		# this set of paths has been kept from thethe original version
  		# of File::HomeDir::Win32 (before it was rewritten).
  		# I can only assume this is Cygwin-related stuff.
  		"C:\\windows\\desktop",
  		"C:\\win95\\desktop",
  		"C:/win95/desktop",
  		"C:/windows/desktop",
  	) {
  		return $fixed if $class->_d($fixed);
  	}
  
  	return undef;
  }
  
  sub my_documents {
  	my $class = shift;
  
  	# The most correct way to find my documents
  	SCOPE: {
  		require Win32;
  		my $dir = Win32::GetFolderPath(Win32::CSIDL_PERSONAL(), CREATE);
  		return $dir if $dir and $class->_d($dir);
  	}
  
  	return undef;
  }
  
  sub my_data {
  	my $class = shift;
  
  	# The most correct way to find my documents
  	SCOPE: {
  		require Win32;
  		my $dir = Win32::GetFolderPath(Win32::CSIDL_LOCAL_APPDATA(), CREATE);
  		return $dir if $dir and $class->_d($dir);
  	}
  
  	return undef;
  }
  
  sub my_music {
  	my $class = shift;
  
  	# The most correct way to find my music
  	SCOPE: {
  		require Win32;
  		my $dir = Win32::GetFolderPath(Win32::CSIDL_MYMUSIC(), CREATE);
  		return $dir if $dir and $class->_d($dir);
  	}
  
  	return undef;
  }
  
  sub my_pictures {
  	my $class = shift;
  
  	# The most correct way to find my pictures
  	SCOPE: {
  		require Win32;
  		my $dir = Win32::GetFolderPath(Win32::CSIDL_MYPICTURES(), CREATE);
  		return $dir if $dir and $class->_d($dir);
  	}
  
  	return undef;
  }
  
  sub my_videos {
  	my $class = shift;
  
  	# The most correct way to find my videos
  	SCOPE: {
  		require Win32;
  		my $dir = Win32::GetFolderPath(Win32::CSIDL_MYVIDEO(), CREATE);
  		return $dir if $dir and $class->_d($dir);
  	}
  
  	return undef;
  }
  
  # Special case version of -d
  sub _d {
  	my $self = shift;
  	my $path = shift;
  
  	# Window can legally return a UNC path from GetFolderPath.
  	# Not only is the meaning of -d complicated in this situation,
  	# but even on a local network calling -d "\\\\cifs\\path" can
  	# take several seconds. UNC can also do even weirder things,
  	# like launching processes and such.
  	# To avoid various crazy bugs caused by this, we do NOT attempt
  	# to validate UNC paths at all so that the code that is calling
  	# us has an opportunity to take special actions without our 
  	# blundering getting in the way.
  	if ( $path =~ /\\\\/ ) {
  		return 1;
  	}
  
  	# Otherwise do a stat as normal
  	return -d $path;
  }
  
  1;
  
  =pod
  
  =head1 NAME
  
  File::HomeDir::Windows - Find your home and other directories on Windows
  
  =head1 SYNOPSIS
  
    use File::HomeDir;
    
    # Find directories for the current user (eg. using Windows XP Professional)
    $home    = File::HomeDir->my_home;        # C:\Documents and Settings\mylogin
    $desktop = File::HomeDir->my_desktop;     # C:\Documents and Settings\mylogin\Desktop
    $docs    = File::HomeDir->my_documents;   # C:\Documents and Settings\mylogin\My Documents
    $music   = File::HomeDir->my_music;       # C:\Documents and Settings\mylogin\My Documents\My Music
    $pics    = File::HomeDir->my_pictures;    # C:\Documents and Settings\mylogin\My Documents\My Pictures
    $videos  = File::HomeDir->my_videos;      # C:\Documents and Settings\mylogin\My Documents\My Video
    $data    = File::HomeDir->my_data;        # C:\Documents and Settings\mylogin\Local Settings\Application Data
  
  =head1 DESCRIPTION
  
  This module provides Windows-specific implementations for determining
  common user directories.  In normal usage this module will always be
  used via L<File::HomeDir>.
  
  Internally this module will use L<Win32>::GetFolderPath to fetch the location
  of your directories. As a result of this, in certain unusual situations
  (usually found inside large organisations) the methods may return UNC paths
  such as C<\\cifs.local\home$>.
  
  If your application runs on Windows and you want to have it work comprehensively
  everywhere, you may need to implement your own handling for these paths as they
  can cause strange behaviour.
  
  For example, stat calls to UNC paths may work but block for several seconds, but
  opendir() may not be able to read any files (creating the appearance of an existing
  but empty directory).
  
  To avoid complicating the problem any further, in the rare situation that a UNC path
  is returned by C<GetFolderPath> the usual -d validation checks will B<not> be done.
  
  =head1 SUPPORT
  
  See the support section the main L<File::HomeDir> module.
  
  =head1 AUTHORS
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  Sean M. Burke E<lt>sburke@cpan.orgE<gt>
  
  =head1 SEE ALSO
  
  L<File::HomeDir>, L<File::HomeDir::Win32> (legacy)
  
  =head1 COPYRIGHT
  
  Copyright 2005 - 2011 Adam Kennedy.
  
  Some parts copyright 2000 Sean M. Burke.
  
  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
FILE_HOMEDIR_WINDOWS

$fatpacked{"File/Which.pm"} = <<'FILE_WHICH';
  package File::Which;
  
  use 5.004;
  use strict;
  use Exporter   ();
  use File::Spec ();
  
  use vars qw{$VERSION @ISA @EXPORT @EXPORT_OK};
  BEGIN {
  	$VERSION   = '1.09';
  	@ISA       = 'Exporter';
  	@EXPORT    = 'which';
  	@EXPORT_OK = 'where';
  }
  
  use constant IS_VMS => ($^O eq 'VMS');
  use constant IS_MAC => ($^O eq 'MacOS');
  use constant IS_DOS => ($^O eq 'MSWin32' or $^O eq 'dos' or $^O eq 'os2');
  
  # For Win32 systems, stores the extensions used for
  # executable files
  # For others, the empty string is used
  # because 'perl' . '' eq 'perl' => easier
  my @PATHEXT = ('');
  if ( IS_DOS ) {
  	# WinNT. PATHEXT might be set on Cygwin, but not used.
  	if ( $ENV{PATHEXT} ) {
  		push @PATHEXT, split ';', $ENV{PATHEXT};
  	} else {
  		# Win9X or other: doesn't have PATHEXT, so needs hardcoded.
  		push @PATHEXT, qw{.com .exe .bat};
  	}
  } elsif ( IS_VMS ) {
  	push @PATHEXT, qw{.exe .com};
  }
  
  sub which {
  	my ($exec) = @_;
  
  	return undef unless $exec;
  
  	my $all = wantarray;
  	my @results = ();
  
  	# check for aliases first
  	if ( IS_VMS ) {
  		my $symbol = `SHOW SYMBOL $exec`;
  		chomp($symbol);
  		unless ( $? ) {
  			return $symbol unless $all;
  			push @results, $symbol;
  		}
  	}
  	if ( IS_MAC ) {
  		my @aliases = split /\,/, $ENV{Aliases};
  		foreach my $alias ( @aliases ) {
  			# This has not been tested!!
  			# PPT which says MPW-Perl cannot resolve `Alias $alias`,
  			# let's just hope it's fixed
  			if ( lc($alias) eq lc($exec) ) {
  				chomp(my $file = `Alias $alias`);
  				last unless $file;  # if it failed, just go on the normal way
  				return $file unless $all;
  				push @results, $file;
  				# we can stop this loop as if it finds more aliases matching,
  				# it'll just be the same result anyway
  				last;
  			}
  		}
  	}
  
  	my @path = File::Spec->path;
  	if ( IS_DOS or IS_VMS or IS_MAC ) {
  		unshift @path, File::Spec->curdir;
  	}
  
  	foreach my $base ( map { File::Spec->catfile($_, $exec) } @path ) {
  		for my $ext ( @PATHEXT ) {
  			my $file = $base.$ext;
  
  			# We don't want dirs (as they are -x)
  			next if -d $file;
  
  			if (
  				# Executable, normal case
  				-x _
  				or (
  					# MacOS doesn't mark as executable so we check -e
  					IS_MAC
  					||
  					(
  						IS_DOS
  						and
  						grep {
  							$file =~ /$_\z/i
  						} @PATHEXT[1..$#PATHEXT]
  					)
  					# DOSish systems don't pass -x on
  					# non-exe/bat/com files. so we check -e.
  					# However, we don't want to pass -e on files
  					# that aren't in PATHEXT, like README.
  					and -e _
  				)
  			) {
  				return $file unless $all;
  				push @results, $file;
  			}
  		}
  	}
  
  	if ( $all ) {
  		return @results;
  	} else {
  		return undef;
  	}
  }
  
  sub where {
  	# force wantarray
  	my @res = which($_[0]);
  	return @res;
  }
  
  1;
  
  __END__
  
  =pod
  
  =head1 NAME
  
  File::Which - Portable implementation of the `which' utility
  
  =head1 SYNOPSIS
  
    use File::Which;                  # exports which()
    use File::Which qw(which where);  # exports which() and where()
    
    my $exe_path = which('perldoc');
    
    my @paths = where('perl');
    - Or -
    my @paths = which('perl'); # an array forces search for all of them
  
  =head1 DESCRIPTION
  
  C<File::Which> was created to be able to get the paths to executable programs
  on systems under which the `which' program wasn't implemented in the shell.
  
  C<File::Which> searches the directories of the user's C<PATH> (as returned by
  C<File::Spec-E<gt>path()>), looking for executable files having the name
  specified as a parameter to C<which()>. Under Win32 systems, which do not have a
  notion of directly executable files, but uses special extensions such as C<.exe>
  and C<.bat> to identify them, C<File::Which> takes extra steps to assure that
  you will find the correct file (so for example, you might be searching for
  C<perl>, it'll try F<perl.exe>, F<perl.bat>, etc.)
  
  =head1 Steps Used on Win32, DOS, OS2 and VMS
  
  =head2 Windows NT
  
  Windows NT has a special environment variable called C<PATHEXT>, which is used
  by the shell to look for executable files. Usually, it will contain a list in
  the form C<.EXE;.BAT;.COM;.JS;.VBS> etc. If C<File::Which> finds such an
  environment variable, it parses the list and uses it as the different
  extensions.
  
  =head2 Windows 9x and other ancient Win/DOS/OS2
  
  This set of operating systems don't have the C<PATHEXT> variable, and usually
  you will find executable files there with the extensions C<.exe>, C<.bat> and
  (less likely) C<.com>. C<File::Which> uses this hardcoded list if it's running
  under Win32 but does not find a C<PATHEXT> variable.
  
  =head2 VMS
  
  Same case as Windows 9x: uses C<.exe> and C<.com> (in that order).
  
  =head1 Functions
  
  =head2 which($short_exe_name)
  
  Exported by default.
  
  C<$short_exe_name> is the name used in the shell to call the program (for
  example, C<perl>).
  
  If it finds an executable with the name you specified, C<which()> will return
  the absolute path leading to this executable (for example, F</usr/bin/perl> or
  F<C:\Perl\Bin\perl.exe>).
  
  If it does I<not> find the executable, it returns C<undef>.
  
  If C<which()> is called in list context, it will return I<all> the
  matches.
  
  =head2 where($short_exe_name)
  
  Not exported by default.
  
  Same as C<which($short_exe_name)> in array context. Same as the
  C<`where'> utility, will return an array containing all the path names
  matching C<$short_exe_name>.
  
  =head1 BUGS AND CAVEATS
  
  Not tested on VMS or MacOS, although there is platform specific code
  for those. Anyone who haves a second would be very kind to send me a
  report of how it went.
  
  File::Spec adds the current directory to the front of PATH if on
  Win32, VMS or MacOS. I have no knowledge of those so don't know if the
  current directory is searced first or not. Could someone please tell
  me?
  
  =head1 SUPPORT
  
  Bugs should be reported via the CPAN bug tracker at
  
  L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=File-Which>
  
  For other issues, contact the maintainer.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  Per Einar Ellefsen E<lt>pereinar@cpan.orgE<gt>
  
  Originated in F<modperl-2.0/lib/Apache/Build.pm>. Changed for use in DocSet
  (for the mod_perl site) and Win32-awareness by me, with slight modifications
  by Stas Bekman, then extracted to create C<File::Which>.
  
  Version 0.04 had some significant platform-related changes, taken from
  the Perl Power Tools C<`which'> implementation by Abigail with
  enhancements from Peter Prymmer. See
  L<http://www.perl.com/language/ppt/src/which/index.html> for more
  information.
  
  =head1 COPYRIGHT
  
  Copyright 2002 Per Einar Ellefsen.
  
  Some parts copyright 2009 Adam Kennedy.
  
  This program is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself.
  
  =head1 SEE ALSO
  
  L<File::Spec>, L<which(1)>, Perl Power Tools:
  L<http://www.perl.com/language/ppt/index.html>.
  
  =cut
FILE_WHICH

$fatpacked{"Sort/Naturally.pm"} = <<'SORT_NATURALLY';
  
  require 5;
  package Sort::Naturally;  # Time-stamp: "2004-12-29 18:30:03 AST"
  $VERSION = '1.03';
  @EXPORT = ('nsort', 'ncmp');
  require Exporter;
  @ISA = ('Exporter');
  
  use strict;
  use locale;
  use integer;
  
  #-----------------------------------------------------------------------------
  # constants:
  BEGIN { *DEBUG = sub () {0} unless defined &DEBUG }
  
  use Config ();
  BEGIN {
    # Make a constant such that if a whole-number string is that long
    #  or shorter, we KNOW it's treatable as an integer
    no integer;
    my $x = length(256 ** $Config::Config{'intsize'} / 2) - 1;
    die "Crazy intsize: <$Config::Config{'intsize'}>" if $x < 4;
    eval 'sub MAX_INT_SIZE () {' . $x . '}';
    die $@ if $@;
    print "intsize $Config::Config{'intsize'} => MAX_INT_SIZE $x\n" if DEBUG;
  }
  
  sub X_FIRST () {-1}
  sub Y_FIRST () { 1}
  
  my @ORD = ('same', 'swap', 'asis');
  
  #-----------------------------------------------------------------------------
  # For lack of a preprocessor:
  
  my($code, $guts);
  $guts = <<'EOGUTS';  # This is the guts of both ncmp and nsort:
  
      if($x eq $y) {
        # trap this expensive case first, and then fall thru to tiebreaker
        $rv = 0;
  
      # Convoluted hack to get numerics to sort first, at string start:
      } elsif($x =~ m/^\d/s) {
        if($y =~ m/^\d/s) {
          $rv = 0;    # fall thru to normal comparison for the two numbers
        } else {
          $rv = X_FIRST;
          DEBUG > 1 and print "Numeric-initial $x trumps letter-initial $y\n";
        }
      } elsif($y =~ m/^\d/s) {
        $rv = Y_FIRST;
        DEBUG > 1 and print "Numeric-initial $y trumps letter-initial $x\n";
      } else {
        $rv = 0;
      }
  
      unless($rv) {
        # Normal case:
        $rv = 0;
        DEBUG and print "<$x> and <$y> compared...\n";
  
       Consideration:
        while(length $x and length $y) {
  
          DEBUG > 2 and print " <$x> and <$y>...\n";
  
          # First, non-numeric comparison:
          $x2 = ($x =~ m/^(\D+)/s) ? length($1) : 0;
          $y2 = ($y =~ m/^(\D+)/s) ? length($1) : 0;
          # Now make x2 the min length of the two:
          $x2 = $y2 if $x2 > $y2;
          if($x2) {
            DEBUG > 1 and printf " <%s> and <%s> lexically for length $x2...\n",
              substr($x,0,$x2), substr($y,0,$x2);
            do {
             my $i = substr($x,0,$x2);
             my $j = substr($y,0,$x2);
             my $sv = $i cmp $j;
             print "SCREAM! on <$i><$j> -- $sv != $rv \n" unless $rv == $sv;
             last;
            }
  
  
             if $rv =
             # The ''. things here force a copy that seems to work around a
             #  mysterious intermittent bug that 'use locale' provokes in
             #  many versions of Perl.
                     $cmp
                     ? $cmp->(substr($x,0,$x2) . '',
                              substr($y,0,$x2) . '',
                             )
                     :
                     scalar(( substr($x,0,$x2) . '' ) cmp
                            ( substr($y,0,$x2) . '' )
                            )
            ;
            # otherwise trim and keep going:
            substr($x,0,$x2) = '';
            substr($y,0,$x2) = '';
          }
  
          # Now numeric:
          #  (actually just using $x2 and $y2 as scratch)
  
          if( $x =~ s/^(\d+)//s ) {
            $x2 = $1;
            if( $y =~ s/^(\d+)//s ) {
              # We have two numbers here.
              DEBUG > 1 and print " <$x2> and <$1> numerically\n";
              if(length($x2) < MAX_INT_SIZE and length($1) < MAX_INT_SIZE) {
                # small numbers: we can compare happily
                last if $rv = $x2 <=> $1;
              } else {
                # ARBITRARILY large integers!
  
                # This saves on loss of precision that could happen
                #  with actual stringification.
                # Also, I sense that very large numbers aren't too
                #  terribly common in sort data.
  
                # trim leading 0's:
                ($y2 = $1) =~ s/^0+//s;
                $x2 =~ s/^0+//s;
                print "   Treating $x2 and $y2 as bigint\n" if DEBUG;
  
                no locale; # we want the dumb cmp back.
                last if $rv = (
                   # works only for non-negative whole numbers:
                   length($x2) <=> length($y2)
                     # the longer the numeral, the larger the value
                   or $x2 cmp $y2
                     # between equals, compare lexically!!  amazing but true.
                );
              }
            } else {
              # X is numeric but Y isn't
              $rv = Y_FIRST;
              last;
            }
          } elsif( $y =~ s/^\d+//s ) {  # we don't need to capture the substring
            $rv = X_FIRST;
            last;
          }
           # else one of them is 0-length.
  
         # end-while
        }
      }
  EOGUTS
  
  sub maker {
    my $code = $_[0];
    $code =~ s/~COMPARATOR~/$guts/g || die "Can't find ~COMPARATOR~";
    eval $code;
    die $@ if $@;
  }
  
  ##############################################################################
  
  maker(<<'EONSORT');
  sub nsort {
    # get options:
    my($cmp, $lc);
    ($cmp,$lc) = @{shift @_} if @_ and ref($_[0]) eq 'ARRAY';
  
    return @_ unless @_ > 1 or wantarray; # be clever
  
    my($x, $x2, $y, $y2, $rv);  # scratch vars
  
    # We use a Schwartzian xform to memoize the lc'ing and \W-removal
  
    map $_->[0],
    sort {
      if($a->[0] eq $b->[0]) { 0 }   # trap this expensive case
      else {
  
      $x = $a->[1];
      $y = $b->[1];
  
  ~COMPARATOR~
  
      # Tiebreakers...
      DEBUG > 1 and print " -<${$a}[0]> cmp <${$b}[0]> is $rv ($ORD[$rv])\n";
      $rv ||= (length($x) <=> length($y))  # shorter is always first
          ||  ($cmp and $cmp->($x,$y) || $cmp->($a->[0], $b->[0]))
          ||  ($x      cmp $y     )
          ||  ($a->[0] cmp $b->[0])
      ;
  
      DEBUG > 1 and print "  <${$a}[0]> cmp <${$b}[0]> is $rv ($ORD[$rv])\n";
      $rv;
    }}
  
    map {;
      $x = $lc ? $lc->($_) : lc($_); # x as scratch
      $x =~ s/\W+//s;
      [$_, $x];
    }
    @_
  }
  EONSORT
  
  #-----------------------------------------------------------------------------
  maker(<<'EONCMP');
  sub ncmp {
    # The guts are basically the same as above...
  
    # get options:
    my($cmp, $lc);
    ($cmp,$lc) = @{shift @_} if @_ and ref($_[0]) eq 'ARRAY';
  
    if(@_ == 0) {
      @_ = ($a, $b); # bit of a hack!
      DEBUG > 1 and print "Hacking in <$a><$b>\n";
    } elsif(@_ != 2) {
      require Carp;
      Carp::croak("Not enough options to ncmp!");
    }
    my($a,$b) = @_;
    my($x, $x2, $y, $y2, $rv);  # scratch vars
  
    DEBUG > 1 and print "ncmp args <$a><$b>\n";
    if($a eq $b) { # trap this expensive case
      0;
    } else {
      $x = ($lc ? $lc->($a) : lc($a));
      $x =~ s/\W+//s;
      $y = ($lc ? $lc->($b) : lc($b));
      $y =~ s/\W+//s;
  
  ~COMPARATOR~
  
  
      # Tiebreakers...
      DEBUG > 1 and print " -<$a> cmp <$b> is $rv ($ORD[$rv])\n";
      $rv ||= (length($x) <=> length($y))  # shorter is always first
          ||  ($cmp and $cmp->($x,$y) || $cmp->($a,$b))
          ||  ($x cmp $y)
          ||  ($a cmp $b)
      ;
  
      DEBUG > 1 and print "  <$a> cmp <$b> is $rv\n";
      $rv;
    }
  }
  EONCMP
  
  # clean up:
  undef $guts;
  undef &maker;
  
  #-----------------------------------------------------------------------------
  1;
  
  ############### END OF MAIN SOURCE ###########################################
  __END__
  
  =head1 NAME
  
  Sort::Naturally -- sort lexically, but sort numeral parts numerically
  
  =head1 SYNOPSIS
  
    @them = nsort(qw(
     foo12a foo12z foo13a foo 14 9x foo12 fooa foolio Foolio Foo12a
    ));
    print join(' ', @them), "\n";
  
  Prints:
  
    9x 14 foo fooa foolio Foolio foo12 foo12a Foo12a foo12z foo13a
  
  (Or "foo12a" + "Foo12a" and "foolio" + "Foolio" and might be
  switched, depending on your locale.)
  
  =head1 DESCRIPTION
  
  This module exports two functions, C<nsort> and C<ncmp>; they are used
  in implementing my idea of a "natural sorting" algorithm.  Under natural
  sorting, numeric substrings are compared numerically, and other
  word-characters are compared lexically.
  
  This is the way I define natural sorting:
  
  =over
  
  =item *
  
  Non-numeric word-character substrings are sorted lexically,
  case-insensitively: "Foo" comes between "fish" and "fowl".
  
  =item *
  
  Numeric substrings are sorted numerically:
  "100" comes after "20", not before.
  
  =item *
  
  \W substrings (neither words-characters nor digits) are I<ignored>.
  
  =item *
  
  Our use of \w, \d, \D, and \W is locale-sensitive:  Sort::Naturally
  uses a C<use locale> statement.
  
  =item *
  
  When comparing two strings, where a numeric substring in one
  place is I<not> up against a numeric substring in another,
  the non-numeric always comes first.  This is fudged by
  reading pretending that the lack of a number substring has
  the value -1, like so:
  
    foo       =>  "foo",  -1
    foobar    =>  "foo",  -1,  "bar"
    foo13     =>  "foo",  13,
    foo13xyz  =>  "foo",  13,  "xyz"
  
  That's so that "foo" will come before "foo13", which will come
  before "foobar".
  
  =item *
  
  The start of a string is exceptional: leading non-\W (non-word,
  non-digit)
  components are are ignored, and numbers come I<before> letters.
  
  =item *
  
  I define "numeric substring" just as sequences matching m/\d+/ --
  scientific notation, commas, decimals, etc., are not seen.  If
  your data has thousands separators in numbers
  ("20,000 Leagues Under The Sea" or "20.000 lieues sous les mers"),
  consider stripping them before feeding them to C<nsort> or
  C<ncmp>.
  
  =back
  
  =head2 The nsort function
  
  This function takes a list of strings, and returns a copy of the list,
  sorted.
  
  This is what most people will want to use:
  
    @stuff = nsort(...list...);
  
  When nsort needs to compare non-numeric substrings, it
  uses Perl's C<lc> function in scope of a <use locale>.
  And when nsort needs to lowercase things, it uses Perl's
  C<lc> function in scope of a <use locale>.  If you want nsort
  to use other functions instead, you can specify them in
  an arrayref as the first argument to nsort:
  
    @stuff = nsort( [
                      \&string_comparator,   # optional
                      \&lowercaser_function  # optional
                    ],
                    ...list...
                  );
  
  If you want to specify a string comparator but no lowercaser,
  then the options list is C<[\&comparator, '']> or
  C<[\&comparator]>.  If you want to specify no string comparator
  but a lowercaser, then the options list is
  C<['', \&lowercaser]>.
  
  Any comparator you specify is called as
  C<$comparator-E<gt>($left, $right)>,
  and, like a normal Perl C<cmp> replacement, must return
  -1, 0, or 1 depending on whether the left argument is stringwise
  less than, equal to, or greater than the right argument.
  
  Any lowercaser function you specify is called as
  C<$lowercased = $lowercaser-E<gt>($original)>.  The routine
  must not modify its C<$_[0]>.
  
  =head2 The ncmp function
  
  Often, when sorting non-string values like this:
  
     @objects_sorted = sort { $a->tag cmp $b->tag } @objects;
  
  ...or even in a Schwartzian transform, like this:
  
     @strings =
       map $_->[0]
       sort { $a->[1] cmp $b->[1] }
       map { [$_, make_a_sort_key_from($_) ]
       @_
     ;
  
  ...you wight want something that replaces not C<sort>, but C<cmp>.
  That's what Sort::Naturally's C<ncmp> function is for.  Call it with
  the syntax C<ncmp($left,$right)> instead of C<$left cmp $right>,
  but otherwise it's a fine replacement:
  
     @objects_sorted = sort { ncmp($a->tag,$b->tag) } @objects;
  
     @strings =
       map $_->[0]
       sort { ncmp($a->[1], $b->[1]) }
       map { [$_, make_a_sort_key_from($_) ]
       @_
     ;
  
  Just as with C<nsort> can take different a string-comparator
  and/or lowercaser, you can do the same with C<ncmp>, by passing
  an arrayref as the first argument:
  
    ncmp( [
            \&string_comparator,   # optional
            \&lowercaser_function  # optional
          ],
          $left, $right
        )
  
  You might get string comparators from L<Sort::ArbBiLex|Sort::ArbBiLex>.
  
  =head1 NOTES
  
  =over
  
  =item *
  
  This module is not a substitute for
  L<Sort::Versions|Sort::Versions>!  If
  you just need proper version sorting, use I<that!>
  
  =item *
  
  If you need something that works I<sort of> like this module's
  functions, but not quite the same, consider scouting thru this
  module's source code, and adapting what you see.  Besides
  the functions that actually compile in this module, after the POD,
  there's several alternate attempts of mine at natural sorting
  routines, which are not compiled as part of the module, but which you
  might find useful.  They should all be I<working> implementations of
  slightly different algorithms
  (all of them based on Martin Pool's C<nsort>) which I eventually
  discarded in favor of my algorithm.  If you are having to
  naturally-sort I<very large> data sets, and sorting is getting
  ridiculously slow, you might consider trying one of those
  discarded functions -- I have a feeling they might be faster on
  large data sets.  Benchmark them on your data and see.  (Unless
  you I<need> the speed, don't bother.  Hint: substitute C<sort>
  for C<nsort> in your code, and unless your program speeds up
  drastically, it's not the sorting that's slowing things down.
  But if it I<is> C<nsort> that's slowing things down, consider
  just:
  
        if(@set >= SOME_VERY_BIG_NUMBER) {
          no locale; # vroom vroom
          @sorted = sort(@set);  # feh, good enough
        } elsif(@set >= SOME_BIG_NUMBER) {
          use locale;
          @sorted = sort(@set);  # feh, good enough
        } else {
          # but keep it pretty for normal cases
          @sorted = nsort(@set);
        }
  
  =item *
  
  If you do adapt the routines in this module, email me; I'd
  just be interested in hearing about it.
  
  =item *
  
  Thanks to the EFNet #perl people for encouraging this module,
  especially magister and a-mused.
  
  =back
  
  =head1 COPYRIGHT AND DISCLAIMER
  
  Copyright 2001, Sean M. Burke C<sburke@cpan.org>, all rights
  reserved.  This program is free software; you can redistribute it
  and/or modify it under the same terms as Perl itself.
  
  This program is distributed in the hope that it will be useful, but
  without any warranty; without even the implied warranty of
  merchantability or fitness for a particular purpose.
  
  =head1 AUTHOR
  
  Sean M. Burke C<sburke@cpan.org>
  
  =cut
  
  ############   END OF DOCS   ############
  
  ############################################################################
  ############################################################################
  
  ############ BEGIN OLD STUFF ############
  
  # We can't have "use integer;", or else (5 <=> 5.1) comes out "0" !
  
  #-----------------------------------------------------------------------------
  sub nsort {
    my($cmp, $lc);
    return @_ if @_ < 2;   # Just to be CLEVER.
  
    my($x, $i);  # scratch vars
  
    # And now, the GREAT BIG Schwartzian transform:
  
    map
      $_->[0],
  
    sort {
      # Uses $i as the index variable, $x as the result.
      $x = 0;
      $i = 1;
      DEBUG and print "\nComparing ", map("{$_}", @$a),
                   ' : ', map("{$_}", @$b), , "...\n";
  
      while($i < @$a and $i < @$b) {
        DEBUG and print "  comparing $i: {$a->[$i]} cmp {$b->[$i]} => ",
          $a->[$i] cmp $b->[$i], "\n";
        last if ($x = ($a->[$i] cmp $b->[$i])); # lexicographic
        ++$i;
  
        DEBUG and print "  comparing $i: {$a->[$i]} <=> {$b->[$i]} => ",
          $a->[$i] <=> $b->[$i], "\n";
        last if ($x = ($a->[$i] <=> $b->[$i])); # numeric
        ++$i;
      }
  
      DEBUG and print "{$a->[0]} : {$b->[0]} is ",
        $x || (@$a <=> @$b) || 0
        ,"\n"
      ;
      $x || (@$a <=> @$b) || ($a->[0] cmp $b->[0]);
        # unless we found a result for $x in the while loop,
        #  use length as a tiebreaker, otherwise use cmp
        #  on the original string as a fallback tiebreaker.
    }
  
    map {
      my @bit = ($x = defined($_) ? $_ : '');
  
      if($x =~ m/^[+-]?(?=\d|\.\d)\d*(?:\.\d*)?(?:[Ee](?:[+-]?\d+))?\z/s) {
        # It's entirely purely numeric, so treat it specially:
        push @bit, '', $x;
      } else {
        # Consume the string.
        while(length $x) {
          push @bit, ($x =~ s/^(\D+)//s) ? lc($1) : '';
          push @bit, ($x =~ s/^(\d+)//s) ?    $1  :  0;
        }
      }
      DEBUG and print "$bit[0] => ", map("{$_} ", @bit), "\n";
  
      # End result: [original bit         , (text, number), (text, number), ...]
      # Minimally:  [0-length original bit,]
      # Examples:
      #    ['10'         => ''   ,  10,              ]
      #    ['fo900'      => 'fo' , 900,              ]
      #    ['foo10'      => 'foo',  10,              ]
      #    ['foo9.pl'    => 'foo',   9,   , '.pl', 0 ]
      #    ['foo32.pl'   => 'foo',  32,   , '.pl', 0 ]
      #    ['foo325.pl'  => 'foo', 325,   , '.pl', 0 ]
      #  Yes, always an ODD number of elements.
  
      \@bit;
    }
    @_;
  }
  
  #-----------------------------------------------------------------------------
  # Same as before, except without the pure-number trap.
  
  sub nsorts {
    return @_ if @_ < 2;   # Just to be CLEVER.
  
    my($x, $i);  # scratch vars
  
    # And now, the GREAT BIG Schwartzian transform:
  
    map
      $_->[0],
  
    sort {
      # Uses $i as the index variable, $x as the result.
      $x = 0;
      $i = 1;
      DEBUG and print "\nComparing ", map("{$_}", @$a),
                   ' : ', map("{$_}", @$b), , "...\n";
  
      while($i < @$a and $i < @$b) {
        DEBUG and print "  comparing $i: {$a->[$i]} cmp {$b->[$i]} => ",
          $a->[$i] cmp $b->[$i], "\n";
        last if ($x = ($a->[$i] cmp $b->[$i])); # lexicographic
        ++$i;
  
        DEBUG and print "  comparing $i: {$a->[$i]} <=> {$b->[$i]} => ",
          $a->[$i] <=> $b->[$i], "\n";
        last if ($x = ($a->[$i] <=> $b->[$i])); # numeric
        ++$i;
      }
  
      DEBUG and print "{$a->[0]} : {$b->[0]} is ",
        $x || (@$a <=> @$b) || 0
        ,"\n"
      ;
      $x || (@$a <=> @$b) || ($a->[0] cmp $b->[0]);
        # unless we found a result for $x in the while loop,
        #  use length as a tiebreaker, otherwise use cmp
        #  on the original string as a fallback tiebreaker.
    }
  
    map {
      my @bit = ($x = defined($_) ? $_ : '');
  
      while(length $x) {
        push @bit, ($x =~ s/^(\D+)//s) ? lc($1) : '';
        push @bit, ($x =~ s/^(\d+)//s) ?    $1  :  0;
      }
      DEBUG and print "$bit[0] => ", map("{$_} ", @bit), "\n";
  
      # End result: [original bit         , (text, number), (text, number), ...]
      # Minimally:  [0-length original bit,]
      # Examples:
      #    ['10'         => ''   ,  10,              ]
      #    ['fo900'      => 'fo' , 900,              ]
      #    ['foo10'      => 'foo',  10,              ]
      #    ['foo9.pl'    => 'foo',   9,   , '.pl', 0 ]
      #    ['foo32.pl'   => 'foo',  32,   , '.pl', 0 ]
      #    ['foo325.pl'  => 'foo', 325,   , '.pl', 0 ]
      #  Yes, always an ODD number of elements.
  
      \@bit;
    }
    @_;
  }
  
  #-----------------------------------------------------------------------------
  # Same as before, except for the sort-key-making
  
  sub nsort0 {
    return @_ if @_ < 2;   # Just to be CLEVER.
  
    my($x, $i);  # scratch vars
  
    # And now, the GREAT BIG Schwartzian transform:
  
    map
      $_->[0],
  
    sort {
      # Uses $i as the index variable, $x as the result.
      $x = 0;
      $i = 1;
      DEBUG and print "\nComparing ", map("{$_}", @$a),
                   ' : ', map("{$_}", @$b), , "...\n";
  
      while($i < @$a and $i < @$b) {
        DEBUG and print "  comparing $i: {$a->[$i]} cmp {$b->[$i]} => ",
          $a->[$i] cmp $b->[$i], "\n";
        last if ($x = ($a->[$i] cmp $b->[$i])); # lexicographic
        ++$i;
  
        DEBUG and print "  comparing $i: {$a->[$i]} <=> {$b->[$i]} => ",
          $a->[$i] <=> $b->[$i], "\n";
        last if ($x = ($a->[$i] <=> $b->[$i])); # numeric
        ++$i;
      }
  
      DEBUG and print "{$a->[0]} : {$b->[0]} is ",
        $x || (@$a <=> @$b) || 0
        ,"\n"
      ;
      $x || (@$a <=> @$b) || ($a->[0] cmp $b->[0]);
        # unless we found a result for $x in the while loop,
        #  use length as a tiebreaker, otherwise use cmp
        #  on the original string as a fallback tiebreaker.
    }
  
    map {
      my @bit = ($x = defined($_) ? $_ : '');
  
      if($x =~ m/^[+-]?(?=\d|\.\d)\d*(?:\.\d*)?(?:[Ee](?:[+-]?\d+))?\z/s) {
        # It's entirely purely numeric, so treat it specially:
        push @bit, '', $x;
      } else {
        # Consume the string.
        while(length $x) {
          push @bit, ($x =~ s/^(\D+)//s) ? lc($1) : '';
          # Secret sauce:
          if($x =~ s/^(\d+)//s) {
            if(substr($1,0,1) eq '0' and $1 != 0) {
              push @bit, $1 / (10 ** length($1));
            } else {
              push @bit, $1;
            }
          } else {
            push @bit, 0;
          }
        }
      }
      DEBUG and print "$bit[0] => ", map("{$_} ", @bit), "\n";
  
      \@bit;
    }
    @_;
  }
  
  #-----------------------------------------------------------------------------
  # Like nsort0, but WITHOUT pure number handling, and WITH special treatment
  # of pulling off extensions and version numbers.
  
  sub nsortf {
    return @_ if @_ < 2;   # Just to be CLEVER.
  
    my($x, $i);  # scratch vars
  
    # And now, the GREAT BIG Schwartzian transform:
  
    map
      $_->[0],
  
    sort {
      # Uses $i as the index variable, $x as the result.
      $x = 0;
      $i = 3;
      DEBUG and print "\nComparing ", map("{$_}", @$a),
                   ' : ', map("{$_}", @$b), , "...\n";
  
      while($i < @$a and $i < @$b) {
        DEBUG and print "  comparing $i: {$a->[$i]} cmp {$b->[$i]} => ",
          $a->[$i] cmp $b->[$i], "\n";
        last if ($x = ($a->[$i] cmp $b->[$i])); # lexicographic
        ++$i;
  
        DEBUG and print "  comparing $i: {$a->[$i]} <=> {$b->[$i]} => ",
          $a->[$i] <=> $b->[$i], "\n";
        last if ($x = ($a->[$i] <=> $b->[$i])); # numeric
        ++$i;
      }
  
      DEBUG and print "{$a->[0]} : {$b->[0]} is ",
        $x || (@$a <=> @$b) || 0
        ,"\n"
      ;
      $x || (@$a     <=> @$b    ) || ($a->[1] cmp $b->[1])
         || ($a->[2] <=> $b->[2]) || ($a->[0] cmp $b->[0]);
        # unless we found a result for $x in the while loop,
        #  use length as a tiebreaker, otherwise use the
        #  lc'd extension, otherwise the verison, otherwise use
        #  the original string as a fallback tiebreaker.
    }
  
    map {
      my @bit = ( ($x = defined($_) ? $_ : ''), '',0 );
  
      {
        # Consume the string.
  
        # First, pull off any VAX-style version
        $bit[2] = $1 if $x =~ s/;(\d+)$//;
  
        # Then pull off any apparent extension
        if( $x !~ m/^\.+$/s and     # don't mangle ".", "..", or "..."
            $x =~ s/(\.[^\.\;]*)$//sg
            # We could try to avoid catching all-digit extensions,
            #  but I think that's getting /too/ clever.
        ) {
          $i = $1;
          if($x =~ m<[^\\\://]$>s) {
            # We didn't take the whole basename.
            $bit[1] = lc $i;
            DEBUG and print "Consuming extension \"$1\"\n";
          } else {
            # We DID take the whole basename.  Fix it.
            $x = $1;  # Repair it.
          }
        }
  
        push @bit, '', -1   if $x =~ m/^\./s;
         # A hack to make .-initial filenames sort first, regardless of locale.
         # And -1 is always a sort-firster, since in the code below, there's
         # no allowance for filenames containing negative numbers: -1.dat
         # will be read as string '-' followed by number 1.
  
        while(length $x) {
          push @bit, ($x =~ s/^(\D+)//s) ? lc($1) : '';
          # Secret sauce:
          if($x =~ s/^(\d+)//s) {
            if(substr($1,0,1) eq '0' and $1 != 0) {
              push @bit, $1 / (10 ** length($1));
            } else {
              push @bit, $1;
            }
          } else {
            push @bit, 0;
          }
        }
      }
  
      DEBUG and print "$bit[0] => ", map("{$_} ", @bit), "\n";
  
      \@bit;
    }
    @_;
  }
  
  # yowza yowza yowza.
  
SORT_NATURALLY

$fatpacked{"Term/ANSIColor.pm"} = <<'TERM_ANSICOLOR';
  # Term::ANSIColor -- Color screen output using ANSI escape sequences.
  #
  # Copyright 1996, 1997, 1998, 2000, 2001, 2002, 2005, 2006, 2008, 2009, 2010,
  #     2011, 2012 Russ Allbery <rra@stanford.edu> and Zenin
  # PUSH/POP support submitted 2007 by openmethods.com voice solutions
  #
  # This program is free software; you may redistribute it and/or modify it
  # under the same terms as Perl itself.
  #
  # Ah, September, when the sysadmins turn colors and fall off the trees....
  #                               -- Dave Van Domelen
  
  ##############################################################################
  # Modules and declarations
  ##############################################################################
  
  package Term::ANSIColor;
  require 5.001;
  
  $VERSION = '3.02';
  
  use strict;
  use vars qw($AUTOLOAD $AUTOLOCAL $AUTORESET @COLORLIST @COLORSTACK $EACHLINE
              @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION %ATTRIBUTES
              %ATTRIBUTES_R);
  
  use Exporter ();
  BEGIN {
      @COLORLIST = qw(
          CLEAR           RESET             BOLD            DARK
          FAINT           ITALIC            UNDERLINE       UNDERSCORE
          BLINK           REVERSE           CONCEALED
  
          BLACK           RED               GREEN           YELLOW
          BLUE            MAGENTA           CYAN            WHITE
          ON_BLACK        ON_RED            ON_GREEN        ON_YELLOW
          ON_BLUE         ON_MAGENTA        ON_CYAN         ON_WHITE
  
          BRIGHT_BLACK    BRIGHT_RED        BRIGHT_GREEN    BRIGHT_YELLOW
          BRIGHT_BLUE     BRIGHT_MAGENTA    BRIGHT_CYAN     BRIGHT_WHITE
          ON_BRIGHT_BLACK ON_BRIGHT_RED     ON_BRIGHT_GREEN ON_BRIGHT_YELLOW
          ON_BRIGHT_BLUE  ON_BRIGHT_MAGENTA ON_BRIGHT_CYAN  ON_BRIGHT_WHITE
      );
      @ISA         = qw(Exporter);
      @EXPORT      = qw(color colored);
      @EXPORT_OK   = qw(uncolor colorstrip colorvalid);
      %EXPORT_TAGS = (constants => \@COLORLIST,
                      pushpop   => [ @COLORLIST,
                                     qw(PUSHCOLOR POPCOLOR LOCALCOLOR) ]);
      Exporter::export_ok_tags ('pushpop');
  }
  
  ##############################################################################
  # Internal data structures
  ##############################################################################
  
  %ATTRIBUTES = ('clear'          => 0,
                 'reset'          => 0,
                 'bold'           => 1,
                 'dark'           => 2,
                 'faint'          => 2,
                 'italic'         => 3,
                 'underline'      => 4,
                 'underscore'     => 4,
                 'blink'          => 5,
                 'reverse'        => 7,
                 'concealed'      => 8,
  
                 'black'          => 30,   'on_black'          => 40,
                 'red'            => 31,   'on_red'            => 41,
                 'green'          => 32,   'on_green'          => 42,
                 'yellow'         => 33,   'on_yellow'         => 43,
                 'blue'           => 34,   'on_blue'           => 44,
                 'magenta'        => 35,   'on_magenta'        => 45,
                 'cyan'           => 36,   'on_cyan'           => 46,
                 'white'          => 37,   'on_white'          => 47,
  
                 'bright_black'   => 90,   'on_bright_black'   => 100,
                 'bright_red'     => 91,   'on_bright_red'     => 101,
                 'bright_green'   => 92,   'on_bright_green'   => 102,
                 'bright_yellow'  => 93,   'on_bright_yellow'  => 103,
                 'bright_blue'    => 94,   'on_bright_blue'    => 104,
                 'bright_magenta' => 95,   'on_bright_magenta' => 105,
                 'bright_cyan'    => 96,   'on_bright_cyan'    => 106,
                 'bright_white'   => 97,   'on_bright_white'   => 107,
                 );
  
  # Reverse lookup.  Alphabetically first name for a sequence is preferred.
  for (reverse sort keys %ATTRIBUTES) {
      $ATTRIBUTES_R{$ATTRIBUTES{$_}} = $_;
  }
  
  ##############################################################################
  # Implementation (constant form)
  ##############################################################################
  
  # Time to have fun!  We now want to define the constant subs, which are named
  # the same as the attributes above but in all caps.  Each constant sub needs
  # to act differently depending on whether $AUTORESET is set.  Without
  # autoreset:
  #
  #     BLUE "text\n"  ==>  "\e[34mtext\n"
  #
  # If $AUTORESET is set, we should instead get:
  #
  #     BLUE "text\n"  ==>  "\e[34mtext\n\e[0m"
  #
  # The sub also needs to handle the case where it has no arguments correctly.
  # Maintaining all of this as separate subs would be a major nightmare, as well
  # as duplicate the %ATTRIBUTES hash, so instead we define an AUTOLOAD sub to
  # define the constant subs on demand.  To do that, we check the name of the
  # called sub against the list of attributes, and if it's an all-caps version
  # of one of them, we define the sub on the fly and then run it.
  #
  # If the environment variable ANSI_COLORS_DISABLED is set, just return the
  # arguments without adding any escape sequences.  This is to make it easier to
  # write scripts that also work on systems without any ANSI support, like
  # Windows consoles.
  sub AUTOLOAD {
      if ($AUTOLOAD =~ /^([\w:]*::([A-Z_]+))$/ and defined $ATTRIBUTES{lc $2}) {
          if (defined $ENV{ANSI_COLORS_DISABLED}) {
              return join ('', @_);
          }
          $AUTOLOAD = $1;
          my $attr = "\e[" . $ATTRIBUTES{lc $2} . 'm';
          my $saved = $@;
          eval qq {
              sub $AUTOLOAD {
                  if (\$AUTORESET && \@_) {
                      return '$attr' . join ('', \@_) . "\e[0m";
                  } elsif (\$AUTOLOCAL && \@_) {
                      return PUSHCOLOR ('$attr') . join ('', \@_) . POPCOLOR;
                  } else {
                      return '$attr' . join ('', \@_);
                  }
              }
          };
          die "failed to generate constant $1" if $@;
          $@ = $saved;
          goto &$AUTOLOAD;
      } else {
          require Carp;
          Carp::croak ("undefined subroutine &$AUTOLOAD called");
      }
  }
  
  # Append a new color to the top of the color stack and return the top of
  # the stack.
  sub PUSHCOLOR {
      my ($text) = @_;
      my ($color) = ($text =~ m/^((?:\e\[[\d;]+m)+)/);
      if (@COLORSTACK) {
          $color = $COLORSTACK[-1] . $color;
      }
      push (@COLORSTACK, $color);
      return $text;
  }
  
  # Pop the color stack and return the new top of the stack (or reset, if
  # the stack is empty).
  sub POPCOLOR {
      pop @COLORSTACK;
      if (@COLORSTACK) {
          return $COLORSTACK[-1] . join ('', @_);
      } else {
          return RESET (@_);
      }
  }
  
  # Surround arguments with a push and a pop.
  sub LOCALCOLOR {
      return PUSHCOLOR (join ('', @_)) . POPCOLOR ();
  }
  
  ##############################################################################
  # Implementation (attribute string form)
  ##############################################################################
  
  # Return the escape code for a given set of color attributes.
  sub color {
      return '' if defined $ENV{ANSI_COLORS_DISABLED};
      my @codes = map { split } @_;
      my $attribute = '';
      foreach (@codes) {
          $_ = lc $_;
          unless (defined $ATTRIBUTES{$_}) {
              require Carp;
              Carp::croak ("Invalid attribute name $_");
          }
          $attribute .= $ATTRIBUTES{$_} . ';';
      }
      chop $attribute;
      return ($attribute ne '') ? "\e[${attribute}m" : undef;
  }
  
  # Return a list of named color attributes for a given set of escape codes.
  # Escape sequences can be given with or without enclosing "\e[" and "m".  The
  # empty escape sequence '' or "\e[m" gives an empty list of attrs.
  sub uncolor {
      my (@nums, @result);
      for (@_) {
          my $escape = $_;
          $escape =~ s/^\e\[//;
          $escape =~ s/m$//;
          unless ($escape =~ /^((?:\d+;)*\d*)$/) {
              require Carp;
              Carp::croak ("Bad escape sequence $escape");
          }
          push (@nums, split (/;/, $1));
      }
      for (@nums) {
          $_ += 0; # Strip leading zeroes
          my $name = $ATTRIBUTES_R{$_};
          if (!defined $name) {
              require Carp;
              Carp::croak ("No name for escape sequence $_" );
          }
          push (@result, $name);
      }
      return @result;
  }
  
  # Given a string and a set of attributes, returns the string surrounded by
  # escape codes to set those attributes and then clear them at the end of the
  # string.  The attributes can be given either as an array ref as the first
  # argument or as a list as the second and subsequent arguments.  If $EACHLINE
  # is set, insert a reset before each occurrence of the string $EACHLINE and
  # the starting attribute code after the string $EACHLINE, so that no attribute
  # crosses line delimiters (this is often desirable if the output is to be
  # piped to a pager or some other program).
  sub colored {
      my ($string, @codes);
      if (ref ($_[0]) && ref ($_[0]) eq 'ARRAY') {
          @codes = @{+shift};
          $string = join ('', @_);
      } else {
          $string = shift;
          @codes = @_;
      }
      return $string if defined $ENV{ANSI_COLORS_DISABLED};
      if (defined $EACHLINE) {
          my $attr = color (@codes);
          return join '',
              map { ($_ ne $EACHLINE) ? $attr . $_ . "\e[0m" : $_ }
                  grep { length ($_) > 0 }
                      split (/(\Q$EACHLINE\E)/, $string);
      } else {
          return color (@codes) . $string . "\e[0m";
      }
  }
  
  # Given a string, strip the ANSI color codes out of that string and return the
  # result.  This removes only ANSI color codes, not movement codes and other
  # escape sequences.
  sub colorstrip {
      my (@string) = @_;
      for my $string (@string) {
          $string =~ s/\e\[[\d;]*m//g;
      }
      return wantarray ? @string : join ('', @string);
  }
  
  # Given a list of color attributes (arguments for color, for instance), return
  # true if they're all valid or false if any of them are invalid.
  sub colorvalid {
      my @codes = map { split } @_;
      for (@codes) {
          unless (defined $ATTRIBUTES{lc $_}) {
              return;
          }
      }
      return 1;
  }
  
  ##############################################################################
  # Module return value and documentation
  ##############################################################################
  
  # Ensure we evaluate to true.
  1;
  __END__
  
  =head1 NAME
  
  Term::ANSIColor - Color screen output using ANSI escape sequences
  
  =for stopwords
  cyan colorize namespace runtime TMTOWTDI cmd.exe 4nt.exe command.com NT
  ESC Delvare SSH OpenSSH aixterm ECMA-048 Fraktur overlining Zenin
  reimplemented Allbery PUSHCOLOR POPCOLOR LOCALCOLOR openmethods.com
  grey ATTR urxvt mistyped
  
  =head1 SYNOPSIS
  
      use Term::ANSIColor;
      print color 'bold blue';
      print "This text is bold blue.\n";
      print color 'reset';
      print "This text is normal.\n";
      print colored ("Yellow on magenta.", 'yellow on_magenta'), "\n";
      print "This text is normal.\n";
      print colored ['yellow on_magenta'], 'Yellow on magenta.', "\n";
      print colored ['red on_bright_yellow'], 'Red on bright yellow.', "\n";
      print colored ['bright_red on_black'], 'Bright red on black.', "\n";
      print "\n";
  
      use Term::ANSIColor qw(uncolor);
      print uncolor ('01;31'), "\n";
  
      use Term::ANSIColor qw(colorstrip);
      print colorstrip '\e[1mThis is bold\e[0m', "\n";
  
      use Term::ANSIColor qw(colorvalid);
      my $valid = colorvalid ('blue bold', 'on_magenta');
      print "Color string is ", $valid ? "valid\n" : "invalid\n";
  
      use Term::ANSIColor qw(:constants);
      print BOLD, BLUE, "This text is in bold blue.\n", RESET;
  
      use Term::ANSIColor qw(:constants);
      {
          local $Term::ANSIColor::AUTORESET = 1;
          print BOLD BLUE "This text is in bold blue.\n";
          print "This text is normal.\n";
      }
  
      use Term::ANSIColor qw(:pushpop);
      print PUSHCOLOR RED ON_GREEN "This text is red on green.\n";
      print PUSHCOLOR BRIGHT_BLUE "This text is bright blue on green.\n";
      print RESET BRIGHT_BLUE "This text is just bright blue.\n";
      print POPCOLOR "Back to red on green.\n";
      print LOCALCOLOR GREEN ON_BLUE "This text is green on blue.\n";
      print "This text is red on green.\n";
      {
          local $Term::ANSIColor::AUTOLOCAL = 1;
          print ON_BLUE "This text is red on blue.\n";
          print "This text is red on green.\n";
      }
      print POPCOLOR "Back to whatever we started as.\n";
  
  =head1 DESCRIPTION
  
  This module has two interfaces, one through color() and colored() and the
  other through constants.  It also offers the utility functions uncolor(),
  colorstrip(), and colorvalid(), which have to be explicitly imported to be
  used (see L</SYNOPSIS>).
  
  =head2 Supported Colors
  
  Terminal emulators that support color divide into two types: ones that
  support only eight colors, and ones that support sixteen.  This module
  provides both the ANSI escape codes for the "normal" colors, supported by
  both types, as well as the additional colors supported by sixteen-color
  emulators.  These colors are referred to as ANSI colors 0 through 7
  (normal) and 8 through 15.
  
  Unfortunately, interpretation of colors 0 through 7 often depends on
  whether the emulator supports eight colors or sixteen colors.  Emulators
  that only support eight colors (such as the Linux console) will display
  colors 0 through 7 with normal brightness and ignore colors 8 through 15,
  treating them the same as white.  Emulators that support 16 colors, such
  as gnome-terminal, normally display colors 0 through 7 as dim or darker
  versions and colors 8 through 15 as normal brightness.  On such emulators,
  the "normal" white (color 7) usually is shown as pale grey, requiring
  bright white (15) to be used to get a real white color.  Bright black
  usually is a dark grey color, although some terminals display it as pure
  black.  Some sixteen-color terminal emulators also treat normal yellow
  (color 3) as orange or brown, and bright yellow (color 11) as yellow.
  
  Following the normal convention of sixteen-color emulators, this module
  provides a pair of attributes for each color.  For every normal color (0
  through 7), the corresponding bright color (8 through 15) is obtained by
  prepending the string C<bright_> to the normal color name.  For example,
  C<red> is color 1 and C<bright_red> is color 9.  The same applies for
  background colors: C<on_red> is the normal color and C<on_bright_red> is
  the bright color.  Capitalize these strings for the constant interface.
  
  There is unfortunately no way to know whether the current emulator
  supports sixteen colors or not, which makes the choice of colors
  difficult.  The most conservative choice is to use only the regular
  colors, which are at least displayed on all emulators.  However, they will
  appear dark in sixteen-color terminal emulators, including most common
  emulators in UNIX X environments.  If you know the display is one of those
  emulators, you may wish to use the bright variants instead.  Even better,
  offer the user a way to configure the colors for a given application to
  fit their terminal emulator.
  
  Support for colors 8 through 15 (the C<bright_> variants) was added in
  Term::ANSIColor 3.0.
  
  =head2 Function Interface
  
  The function interface uses attribute strings to describe the colors and
  text attributes to assign to text.  The recognized non-color attributes
  are clear, reset, bold, dark, faint, italic, underline, underscore, blink,
  reverse, and concealed.  Clear and reset (reset to default attributes),
  dark and faint (dim and saturated), and underline and underscore are
  equivalent, so use whichever is the most intuitive to you.
  
  Note that not all attributes are supported by all terminal types, and some
  terminals may not support any of these sequences.  Dark and faint, italic,
  blink, and concealed in particular are frequently not implemented.
  
  Support for italic was added in Term::ANSIColor 3.02.
  
  The recognized normal foreground color attributes (colors 0 to 7) are:
  
    black  red  green  yellow  blue  magenta  cyan  white
  
  The corresponding bright foreground color attributes (colors 8 to 15) are:
  
    bright_black  bright_red      bright_green  bright_yellow
    bright_blue   bright_magenta  bright_cyan   bright_white
  
  The recognized normal background color attributes (colors 0 to 7) are:
  
    on_black  on_red      on_green  on yellow
    on_blue   on_magenta  on_cyan   on_white
  
  The recognized bright background color attributes (colors 8 to 15) are:
  
    on_bright_black  on_bright_red      on_bright_green  on_bright_yellow
    on_bright_blue   on_bright_magenta  on_bright_cyan   on_bright_white
  
  For any of the above listed attributes, case is not significant.
  
  Attributes, once set, last until they are unset (by printing the attribute
  C<clear> or C<reset>).  Be careful to do this, or otherwise your attribute
  will last after your script is done running, and people get very annoyed
  at having their prompt and typing changed to weird colors.
  
  =over 4
  
  =item color(ATTR[, ATTR ...])
  
  color() takes any number of strings as arguments and considers them to be
  space-separated lists of attributes.  It then forms and returns the escape
  sequence to set those attributes.  It doesn't print it out, just returns
  it, so you'll have to print it yourself if you want to.  This is so that
  you can save it as a string, pass it to something else, send it to a file
  handle, or do anything else with it that you might care to.  color()
  throws an exception if given an invalid attribute.
  
  =item colored(STRING, ATTRIBUTES)
  
  =item colored(ATTR-REF, STRING[, STRING...])
  
  As an aid in resetting colors, colored() takes a scalar as the first
  argument and any number of attribute strings as the second argument and
  returns the scalar wrapped in escape codes so that the attributes will be
  set as requested before the string and reset to normal after the string.
  Alternately, you can pass a reference to an array as the first argument,
  and then the contents of that array will be taken as attributes and color
  codes and the remainder of the arguments as text to colorize.
  
  Normally, colored() just puts attribute codes at the beginning and end of
  the string, but if you set $Term::ANSIColor::EACHLINE to some string, that
  string will be considered the line delimiter and the attribute will be set
  at the beginning of each line of the passed string and reset at the end of
  each line.  This is often desirable if the output contains newlines and
  you're using background colors, since a background color that persists
  across a newline is often interpreted by the terminal as providing the
  default background color for the next line.  Programs like pagers can also
  be confused by attributes that span lines.  Normally you'll want to set
  $Term::ANSIColor::EACHLINE to C<"\n"> to use this feature.
  
  =item uncolor(ESCAPE)
  
  uncolor() performs the opposite translation as color(), turning escape
  sequences into a list of strings corresponding to the attributes being set
  by those sequences.
  
  =item colorstrip(STRING[, STRING ...])
  
  colorstrip() removes all color escape sequences from the provided strings,
  returning the modified strings separately in array context or joined
  together in scalar context.  Its arguments are not modified.
  
  =item colorvalid(ATTR[, ATTR ...])
  
  colorvalid() takes attribute strings the same as color() and returns true
  if all attributes are known and false otherwise.
  
  =back
  
  =head2 Constant Interface
  
  Alternately, if you import C<:constants>, you can use the following
  constants directly:
  
    CLEAR           RESET             BOLD            DARK
    FAINT           ITALIC            UNDERLINE       UNDERSCORE
    BLINK           REVERSE           CONCEALED
  
    BLACK           RED               GREEN           YELLOW
    BLUE            MAGENTA           CYAN            WHITE
    BRIGHT_BLACK    BRIGHT_RED        BRIGHT_GREEN    BRIGHT_YELLOW
    BRIGHT_BLUE     BRIGHT_MAGENTA    BRIGHT_CYAN     BRIGHT_WHITE
  
    ON_BLACK        ON_RED            ON_GREEN        ON_YELLOW
    ON_BLUE         ON_MAGENTA        ON_CYAN         ON_WHITE
    ON_BRIGHT_BLACK ON_BRIGHT_RED     ON_BRIGHT_GREEN ON_BRIGHT_YELLOW
    ON_BRIGHT_BLUE  ON_BRIGHT_MAGENTA ON_BRIGHT_CYAN  ON_BRIGHT_WHITE
  
  These are the same as color('attribute') and can be used if you prefer
  typing:
  
      print BOLD BLUE ON_WHITE "Text", RESET, "\n";
  
  to
  
      print colored ("Text", 'bold blue on_white'), "\n";
  
  (Note that the newline is kept separate to avoid confusing the terminal as
  described above since a background color is being used.)
  
  Support for C<ITALIC> was added in Term::ANSIColor 3.02.
  
  When using the constants, if you don't want to have to remember to add the
  C<, RESET> at the end of each print line, you can set
  $Term::ANSIColor::AUTORESET to a true value.  Then, the display mode will
  automatically be reset if there is no comma after the constant.  In other
  words, with that variable set:
  
      print BOLD BLUE "Text\n";
  
  will reset the display mode afterward, whereas:
  
      print BOLD, BLUE, "Text\n";
  
  will not.  If you are using background colors, you will probably want to
  print the newline with a separate print statement to avoid confusing the
  terminal.
  
  The subroutine interface has the advantage over the constants interface in
  that only two subroutines are exported into your namespace, versus
  thirty-eight in the constants interface.  On the flip side, the constants
  interface has the advantage of better compile time error checking, since
  misspelled names of colors or attributes in calls to color() and colored()
  won't be caught until runtime whereas misspelled names of constants will
  be caught at compile time.  So, pollute your namespace with almost two
  dozen subroutines that you may not even use that often, or risk a silly
  bug by mistyping an attribute.  Your choice, TMTOWTDI after all.
  
  =head2 The Color Stack
  
  As of Term::ANSIColor 2.0, you can import C<:pushpop> and maintain a stack
  of colors using PUSHCOLOR, POPCOLOR, and LOCALCOLOR.  PUSHCOLOR takes the
  attribute string that starts its argument and pushes it onto a stack of
  attributes.  POPCOLOR removes the top of the stack and restores the
  previous attributes set by the argument of a prior PUSHCOLOR.  LOCALCOLOR
  surrounds its argument in a PUSHCOLOR and POPCOLOR so that the color
  resets afterward.
  
  When using PUSHCOLOR, POPCOLOR, and LOCALCOLOR, it's particularly
  important to not put commas between the constants.
  
      print PUSHCOLOR BLUE "Text\n";
  
  will correctly push BLUE onto the top of the stack.
  
      print PUSHCOLOR, BLUE, "Text\n";    # wrong!
  
  will not, and a subsequent pop won't restore the correct attributes.
  PUSHCOLOR pushes the attributes set by its argument, which is normally a
  string of color constants.  It can't ask the terminal what the current
  attributes are.
  
  =head1 DIAGNOSTICS
  
  =over 4
  
  =item Bad escape sequence %s
  
  (F) You passed an invalid ANSI escape sequence to uncolor().
  
  =item Bareword "%s" not allowed while "strict subs" in use
  
  (F) You probably mistyped a constant color name such as:
  
      $Foobar = FOOBAR . "This line should be blue\n";
  
  or:
  
      @Foobar = FOOBAR, "This line should be blue\n";
  
  This will only show up under use strict (another good reason to run under
  use strict).
  
  =item Invalid attribute name %s
  
  (F) You passed an invalid attribute name to either color() or colored().
  
  =item Name "%s" used only once: possible typo
  
  (W) You probably mistyped a constant color name such as:
  
      print FOOBAR "This text is color FOOBAR\n";
  
  It's probably better to always use commas after constant names in order to
  force the next error.
  
  =item No comma allowed after filehandle
  
  (F) You probably mistyped a constant color name such as:
  
      print FOOBAR, "This text is color FOOBAR\n";
  
  Generating this fatal compile error is one of the main advantages of using
  the constants interface, since you'll immediately know if you mistype a
  color name.
  
  =item No name for escape sequence %s
  
  (F) The ANSI escape sequence passed to uncolor() contains escapes which
  aren't recognized and can't be translated to names.
  
  =back
  
  =head1 ENVIRONMENT
  
  =over 4
  
  =item ANSI_COLORS_DISABLED
  
  If this environment variable is set, all of the functions defined by this
  module (color(), colored(), and all of the constants not previously used
  in the program) will not output any escape sequences and instead will just
  return the empty string or pass through the original text as appropriate.
  This is intended to support easy use of scripts using this module on
  platforms that don't support ANSI escape sequences.
  
  For it to have its proper effect, this environment variable must be set
  before any color constants are used in the program.
  
  =back
  
  =head1 RESTRICTIONS
  
  It would be nice if one could leave off the commas around the constants
  entirely and just say:
  
      print BOLD BLUE ON_WHITE "Text\n" RESET;
  
  but the syntax of Perl doesn't allow this.  You need a comma after the
  string.  (Of course, you may consider it a bug that commas between all the
  constants aren't required, in which case you may feel free to insert
  commas unless you're using $Term::ANSIColor::AUTORESET or
  PUSHCOLOR/POPCOLOR.)
  
  For easier debugging, you may prefer to always use the commas when not
  setting $Term::ANSIColor::AUTORESET or PUSHCOLOR/POPCOLOR so that you'll
  get a fatal compile error rather than a warning.
  
  It's not possible to use this module to embed formatting and color
  attributes using Perl formats.  They replace the escape character with a
  space (as documented in L<perlform(1)>), resulting in garbled output from
  the unrecognized attribute.  Even if there were a way around that problem,
  the format doesn't know that the non-printing escape sequence is
  zero-length and would incorrectly format the output.  For formatted output
  using color or other attributes, either use sprintf() instead or use
  formline() and then add the color or other attributes after formatting and
  before output.
  
  =head1 NOTES
  
  The codes generated by this module are standard terminal control codes,
  complying with ECMA-048 and ISO 6429 (generally referred to as "ANSI
  color" for the color codes).  The non-color control codes (bold, dark,
  italic, underline, and reverse) are part of the earlier ANSI X3.64
  standard for control sequences for video terminals and peripherals.
  
  Note that not all displays are ISO 6429-compliant, or even X3.64-compliant
  (or are even attempting to be so).  This module will not work as expected
  on displays that do not honor these escape sequences, such as cmd.exe,
  4nt.exe, and command.com under either Windows NT or Windows 2000.  They
  may just be ignored, or they may display as an ESC character followed by
  some apparent garbage.
  
  Jean Delvare provided the following table of different common terminal
  emulators and their support for the various attributes and others have
  helped me flesh it out:
  
                clear    bold     faint   under    blink   reverse  conceal
   ------------------------------------------------------------------------
   xterm         yes      yes      no      yes      yes      yes      yes
   linux         yes      yes      yes    bold      yes      yes      no
   rxvt          yes      yes      no      yes  bold/black   yes      no
   dtterm        yes      yes      yes     yes    reverse    yes      yes
   teraterm      yes    reverse    no      yes    rev/red    yes      no
   aixterm      kinda   normal     no      yes      no       yes      yes
   PuTTY         yes     color     no      yes      no       yes      no
   Windows       yes      no       no      no       no       yes      no
   Cygwin SSH    yes      yes      no     color    color    color     yes
   Mac Terminal  yes      yes      no      yes      yes      yes      yes
  
  Windows is Windows telnet, Cygwin SSH is the OpenSSH implementation under
  Cygwin on Windows NT, and Mac Terminal is the Terminal application in Mac
  OS X.  Where the entry is other than yes or no, that emulator displays the
  given attribute as something else instead.  Note that on an aixterm, clear
  doesn't reset colors; you have to explicitly set the colors back to what
  you want.  More entries in this table are welcome.
  
  Support for code 3 (italic) is rare and therefore not mentioned in that
  table.  It is not believed to be fully supported by any of the terminals
  listed, although it's displayed as green in the Linux console, but it is
  reportedly supported by urxvt.
  
  Note that codes 6 (rapid blink) and 9 (strike-through) are specified in
  ANSI X3.64 and ECMA-048 but are not commonly supported by most displays
  and emulators and therefore aren't supported by this module at the present
  time.  ECMA-048 also specifies a large number of other attributes,
  including a sequence of attributes for font changes, Fraktur characters,
  double-underlining, framing, circling, and overlining.  As none of these
  attributes are widely supported or useful, they also aren't currently
  supported by this module.
  
  =head1 SEE ALSO
  
  ECMA-048 is available on-line (at least at the time of this writing) at
  L<http://www.ecma-international.org/publications/standards/Ecma-048.htm>.
  
  ISO 6429 is available from ISO for a charge; the author of this module
  does not own a copy of it.  Since the source material for ISO 6429 was
  ECMA-048 and the latter is available for free, there seems little reason
  to obtain the ISO standard.
  
  The current version of this module is always available from its web site
  at L<http://www.eyrie.org/~eagle/software/ansicolor/>.  It is also part of
  the Perl core distribution as of 5.6.0.
  
  =head1 AUTHORS
  
  Original idea (using constants) by Zenin, reimplemented using subs by Russ
  Allbery <rra@stanford.edu>, and then combined with the original idea by
  Russ with input from Zenin.  Russ Allbery now maintains this module.
  
  =head1 COPYRIGHT AND LICENSE
  
  Copyright 1996, 1997, 1998, 2000, 2001, 2002, 2005, 2006, 2008, 2009,
  2010, 2011, 2012 Russ Allbery <rra@stanford.edu> and Zenin.  This program
  is free software; you may redistribute it and/or modify it under the same
  terms as Perl itself.
  
  PUSHCOLOR, POPCOLOR, and LOCALCOLOR were contributed by openmethods.com
  voice solutions.
  
  =cut
TERM_ANSICOLOR

$fatpacked{"darwin-2level/Cwd.pm"} = <<'DARWIN-2LEVEL_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;
DARWIN-2LEVEL_CWD

$fatpacked{"darwin-2level/File/Spec.pm"} = <<'DARWIN-2LEVEL_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
DARWIN-2LEVEL_FILE_SPEC

$fatpacked{"darwin-2level/File/Spec/Cygwin.pm"} = <<'DARWIN-2LEVEL_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;
DARWIN-2LEVEL_FILE_SPEC_CYGWIN

$fatpacked{"darwin-2level/File/Spec/Epoc.pm"} = <<'DARWIN-2LEVEL_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;
DARWIN-2LEVEL_FILE_SPEC_EPOC

$fatpacked{"darwin-2level/File/Spec/Functions.pm"} = <<'DARWIN-2LEVEL_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
  
DARWIN-2LEVEL_FILE_SPEC_FUNCTIONS

$fatpacked{"darwin-2level/File/Spec/Mac.pm"} = <<'DARWIN-2LEVEL_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;
DARWIN-2LEVEL_FILE_SPEC_MAC

$fatpacked{"darwin-2level/File/Spec/OS2.pm"} = <<'DARWIN-2LEVEL_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
DARWIN-2LEVEL_FILE_SPEC_OS2

$fatpacked{"darwin-2level/File/Spec/Unix.pm"} = <<'DARWIN-2LEVEL_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;
DARWIN-2LEVEL_FILE_SPEC_UNIX

$fatpacked{"darwin-2level/File/Spec/VMS.pm"} = <<'DARWIN-2LEVEL_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;
DARWIN-2LEVEL_FILE_SPEC_VMS

$fatpacked{"darwin-2level/File/Spec/Win32.pm"} = <<'DARWIN-2LEVEL_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;
DARWIN-2LEVEL_FILE_SPEC_WIN32

$fatpacked{"darwin-2level/List/Util.pm"} = <<'DARWIN-2LEVEL_LIST_UTIL';
  # Copyright (c) 1997-2009 Graham Barr <gbarr@pobox.com>. All rights reserved.
  # This program is free software; you can redistribute it and/or
  # modify it under the same terms as Perl itself.
  #
  # Maintained since 2013 by Paul Evans <leonerd@leonerd.org.uk>
  
  package List::Util;
  
  use strict;
  require Exporter;
  
  our @ISA        = qw(Exporter);
  our @EXPORT_OK  = qw(
    all any first min max minstr maxstr none notall product reduce sum sum0 shuffle
    pairmap pairgrep pairfirst pairs pairkeys pairvalues
  );
  our $VERSION    = "1.38";
  our $XS_VERSION = $VERSION;
  $VERSION    = eval $VERSION;
  
  require XSLoader;
  XSLoader::load('List::Util', $XS_VERSION);
  
  sub import
  {
    my $pkg = caller;
  
    # (RT88848) Touch the caller's $a and $b, to avoid the warning of
    #   Name "main::a" used only once: possible typo" warning
    no strict 'refs';
    ${"${pkg}::a"} = ${"${pkg}::a"};
    ${"${pkg}::b"} = ${"${pkg}::b"};
  
    goto &Exporter::import;
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  List::Util - A selection of general-utility list subroutines
  
  =head1 SYNOPSIS
  
      use List::Util qw(first max maxstr min minstr reduce shuffle sum);
  
  =head1 DESCRIPTION
  
  C<List::Util> contains a selection of subroutines that people have expressed
  would be nice to have in the perl core, but the usage would not really be high
  enough to warrant the use of a keyword, and the size so small such that being
  individual extensions would be wasteful.
  
  By default C<List::Util> does not export any subroutines.
  
  =cut
  
  =head1 LIST-REDUCTION FUNCTIONS
  
  The following set of functions all reduce a list down to a single value.
  
  =cut
  
  =head2 $result = reduce { BLOCK } @list
  
  Reduces C<@list> by calling C<BLOCK> in a scalar context multiple times,
  setting C<$a> and C<$b> each time. The first call will be with C<$a> and C<$b>
  set to the first two elements of the list, subsequent calls will be done by
  setting C<$a> to the result of the previous call and C<$b> to the next element
  in the list.
  
  Returns the result of the last call to the C<BLOCK>. If C<@list> is empty then
  C<undef> is returned. If C<@list> only contains one element then that element
  is returned and C<BLOCK> is not executed.
  
  The following examples all demonstrate how C<reduce> could be used to implement
  the other list-reduction functions in this module. (They are not in fact
  implemented like this, but instead in a more efficient manner in individual C
  functions).
  
      $foo = reduce { defined($a)            ? $a :
                      $code->(local $_ = $b) ? $b :
                                               undef } undef, @list # first
  
      $foo = reduce { $a > $b ? $a : $b } 1..10       # max
      $foo = reduce { $a gt $b ? $a : $b } 'A'..'Z'   # maxstr
      $foo = reduce { $a < $b ? $a : $b } 1..10       # min
      $foo = reduce { $a lt $b ? $a : $b } 'aa'..'zz' # minstr
      $foo = reduce { $a + $b } 1 .. 10               # sum
      $foo = reduce { $a . $b } @bar                  # concat
  
      $foo = reduce { $a || $code->(local $_ = $b) } 0, @bar   # any
      $foo = reduce { $a && $code->(local $_ = $b) } 1, @bar   # all
      $foo = reduce { $a && !$code->(local $_ = $b) } 1, @bar  # none
      $foo = reduce { $a || !$code->(local $_ = $b) } 0, @bar  # notall
         # Note that these implementations do not fully short-circuit
  
  If your algorithm requires that C<reduce> produce an identity value, then make
  sure that you always pass that identity value as the first argument to prevent
  C<undef> being returned
  
    $foo = reduce { $a + $b } 0, @values;             # sum with 0 identity value
  
  The remaining list-reduction functions are all specialisations of this generic
  idea.
  
  =head2 $b = any { BLOCK } @list
  
  Similar to C<grep> in that it evaluates C<BLOCK> setting C<$_> to each element
  of C<@list> in turn. C<any> returns true if any element makes the C<BLOCK>
  return a true value. If C<BLOCK> never returns true or C<@list> was empty then
  it returns false.
  
  Many cases of using C<grep> in a conditional can be written using C<any>
  instead, as it can short-circuit after the first true result.
  
      if( any { length > 10 } @strings ) {
          # at least one string has more than 10 characters
      }
  
  =head2 $b = all { BLOCK } @list
  
  Similar to C<any>, except that it requires all elements of the C<@list> to make
  the C<BLOCK> return true. If any element returns false, then it returns false.
  If the C<BLOCK> never returns false or the C<@list> was empty then it returns
  true.
  
  =head2 $b = none { BLOCK } @list
  
  =head2 $b = notall { BLOCK } @list
  
  Similar to C<any> and C<all>, but with the return sense inverted. C<none>
  returns true only if no value in the LIST causes the BLOCK to return true, and
  C<notall> returns true only if not all of the values do.
  
  =head2 $val = first { BLOCK } @list
  
  Similar to C<grep> in that it evaluates C<BLOCK> setting C<$_> to each element
  of C<@list> in turn. C<first> returns the first element where the result from
  C<BLOCK> is a true value. If C<BLOCK> never returns true or C<@list> was empty
  then C<undef> is returned.
  
      $foo = first { defined($_) } @list    # first defined value in @list
      $foo = first { $_ > $value } @list    # first value in @list which
                                            # is greater than $value
  
  =head2 $num = max @list
  
  Returns the entry in the list with the highest numerical value. If the list is
  empty then C<undef> is returned.
  
      $foo = max 1..10                # 10
      $foo = max 3,9,12               # 12
      $foo = max @bar, @baz           # whatever
  
  =head2 $str = maxstr @list
  
  Similar to C<max>, but treats all the entries in the list as strings and
  returns the highest string as defined by the C<gt> operator. If the list is
  empty then C<undef> is returned.
  
      $foo = maxstr 'A'..'Z'          # 'Z'
      $foo = maxstr "hello","world"   # "world"
      $foo = maxstr @bar, @baz        # whatever
  
  =head2 $num = min @list
  
  Similar to C<max> but returns the entry in the list with the lowest numerical
  value. If the list is empty then C<undef> is returned.
  
      $foo = min 1..10                # 1
      $foo = min 3,9,12               # 3
      $foo = min @bar, @baz           # whatever
  
  =head2 $str = minstr @list
  
  Similar to C<min>, but treats all the entries in the list as strings and
  returns the lowest string as defined by the C<lt> operator. If the list is
  empty then C<undef> is returned.
  
      $foo = minstr 'A'..'Z'          # 'A'
      $foo = minstr "hello","world"   # "hello"
      $foo = minstr @bar, @baz        # whatever
  
  =head2 $num = product @list
  
  Returns the numerical product of all the elements in C<@list>. If C<@list> is
  empty then C<1> is returned.
  
      $foo = product 1..10            # 3628800
      $foo = product 3,9,12           # 324
  
  =head2 $num_or_undef = sum @list
  
  Returns the numerical sum of all the elements in C<@list>. For backwards
  compatibility, if C<@list> is empty then C<undef> is returned.
  
      $foo = sum 1..10                # 55
      $foo = sum 3,9,12               # 24
      $foo = sum @bar, @baz           # whatever
  
  =head2 $num = sum0 @list
  
  Similar to C<sum>, except this returns 0 when given an empty list, rather than
  C<undef>.
  
  =cut
  
  =head1 KEY/VALUE PAIR LIST FUNCTIONS
  
  The following set of functions, all inspired by L<List::Pairwise>, consume an
  even-sized list of pairs. The pairs may be key/value associations from a hash,
  or just a list of values. The functions will all preserve the original ordering
  of the pairs, and will not be confused by multiple pairs having the same "key"
  value - nor even do they require that the first of each pair be a plain string.
  
  =cut
  
  =head2 @kvlist = pairgrep { BLOCK } @kvlist
  
  =head2 $count = pairgrep { BLOCK } @kvlist
  
  Similar to perl's C<grep> keyword, but interprets the given list as an
  even-sized list of pairs. It invokes the C<BLOCK> multiple times, in scalar
  context, with C<$a> and C<$b> set to successive pairs of values from the
  C<@kvlist>.
  
  Returns an even-sized list of those pairs for which the C<BLOCK> returned true
  in list context, or the count of the B<number of pairs> in scalar context.
  (Note, therefore, in scalar context that it returns a number half the size of
  the count of items it would have returned in list context).
  
      @subset = pairgrep { $a =~ m/^[[:upper:]]+$/ } @kvlist
  
  As with C<grep> aliasing C<$_> to list elements, C<pairgrep> aliases C<$a> and
  C<$b> to elements of the given list. Any modifications of it by the code block
  will be visible to the caller.
  
  =head2 ( $key, $val ) = pairfirst { BLOCK } @kvlist
  
  =head2 $found = pairfirst { BLOCK } @kvlist
  
  Similar to the C<first> function, but interprets the given list as an
  even-sized list of pairs. It invokes the C<BLOCK> multiple times, in scalar
  context, with C<$a> and C<$b> set to successive pairs of values from the
  C<@kvlist>.
  
  Returns the first pair of values from the list for which the C<BLOCK> returned
  true in list context, or an empty list of no such pair was found. In scalar
  context it returns a simple boolean value, rather than either the key or the
  value found.
  
      ( $key, $value ) = pairfirst { $a =~ m/^[[:upper:]]+$/ } @kvlist
  
  As with C<grep> aliasing C<$_> to list elements, C<pairfirst> aliases C<$a> and
  C<$b> to elements of the given list. Any modifications of it by the code block
  will be visible to the caller.
  
  =head2 @list = pairmap { BLOCK } @kvlist
  
  =head2 $count = pairmap { BLOCK } @kvlist
  
  Similar to perl's C<map> keyword, but interprets the given list as an
  even-sized list of pairs. It invokes the C<BLOCK> multiple times, in list
  context, with C<$a> and C<$b> set to successive pairs of values from the
  C<@kvlist>.
  
  Returns the concatenation of all the values returned by the C<BLOCK> in list
  context, or the count of the number of items that would have been returned in
  scalar context.
  
      @result = pairmap { "The key $a has value $b" } @kvlist
  
  As with C<map> aliasing C<$_> to list elements, C<pairmap> aliases C<$a> and
  C<$b> to elements of the given list. Any modifications of it by the code block
  will be visible to the caller.
  
  =head2 @pairs = pairs @kvlist
  
  A convenient shortcut to operating on even-sized lists of pairs, this function
  returns a list of ARRAY references, each containing two items from the given
  list. It is a more efficient version of
  
      @pairs = pairmap { [ $a, $b ] } @kvlist
  
  It is most convenient to use in a C<foreach> loop, for example:
  
      foreach ( pairs @KVLIST ) {
         my ( $key, $value ) = @$_;
         ...
      }
  
  =head2 @keys = pairkeys @kvlist
  
  A convenient shortcut to operating on even-sized lists of pairs, this function
  returns a list of the the first values of each of the pairs in the given list.
  It is a more efficient version of
  
      @keys = pairmap { $a } @kvlist
  
  =head2 @values = pairvalues @kvlist
  
  A convenient shortcut to operating on even-sized lists of pairs, this function
  returns a list of the the second values of each of the pairs in the given list.
  It is a more efficient version of
  
      @values = pairmap { $b } @kvlist
  
  =cut
  
  =head1 OTHER FUNCTIONS
  
  =cut
  
  =head2 @values = shuffle @values
  
  Returns the values of the input in a random order
  
      @cards = shuffle 0..51      # 0..51 in a random order
  
  =cut
  
  =head1 KNOWN BUGS
  
  With perl versions prior to 5.005 there are some cases where reduce will return
  an incorrect result. This will show up as test 7 of reduce.t failing.
  
  =head1 SUGGESTED ADDITIONS
  
  The following are additions that have been requested, but I have been reluctant
  to add due to them being very simple to implement in perl
  
    # How many elements are true
  
    sub true { scalar grep { $_ } @_ }
  
    # How many elements are false
  
    sub false { scalar grep { !$_ } @_ }
  
  =head1 SEE ALSO
  
  L<Scalar::Util>, L<List::MoreUtils>
  
  =head1 COPYRIGHT
  
  Copyright (c) 1997-2007 Graham Barr <gbarr@pobox.com>. All rights reserved.
  This program is free software; you can redistribute it and/or
  modify it under the same terms as Perl itself.
  
  Recent additions and current maintenance by
  Paul Evans, <leonerd@leonerd.org.uk>.
  
  =cut
DARWIN-2LEVEL_LIST_UTIL

$fatpacked{"darwin-2level/List/Util/XS.pm"} = <<'DARWIN-2LEVEL_LIST_UTIL_XS';
  package List::Util::XS;
  use strict;
  use List::Util;
  
  our $VERSION = "1.38";       # FIXUP
  $VERSION = eval $VERSION;    # FIXUP
  
  1;
  __END__
  
  =head1 NAME
  
  List::Util::XS - Indicate if List::Util was compiled with a C compiler
  
  =head1 SYNOPSIS
  
      use List::Util::XS 1.20;
  
  =head1 DESCRIPTION
  
  C<List::Util::XS> can be used as a dependency to ensure List::Util was
  installed using a C compiler and that the XS version is installed.
  
  During installation C<$List::Util::XS::VERSION> will be set to
  C<undef> if the XS was not compiled.
  
  Starting with release 1.23_03, Scalar-List-Util is B<always> using
  the XS implementation, but for backwards compatibility, we still
  ship the C<List::Util::XS> module which just loads C<List::Util>.
  
  =head1 SEE ALSO
  
  L<Scalar::Util>, L<List::Util>, L<List::MoreUtils>
  
  =head1 COPYRIGHT
  
  Copyright (c) 2008 Graham Barr <gbarr@pobox.com>. All rights reserved.
  This program is free software; you can redistribute it and/or
  modify it under the same terms as Perl itself.
  
  =cut
DARWIN-2LEVEL_LIST_UTIL_XS

$fatpacked{"darwin-2level/Mac/SystemDirectory.pm"} = <<'DARWIN-2LEVEL_MAC_SYSTEMDIRECTORY';
  package Mac::SystemDirectory;
  
  use 5.006000;
  use strict;
  use warnings;
  
  BEGIN {
      our $VERSION     = '0.06';
      our @EXPORT_OK   = ('FindDirectory', 'HomeDirectory', 'TemporaryDirectory');
  
      require XSLoader;
      XSLoader::load('Mac::SystemDirectory', $VERSION);
  
      our %EXPORT_TAGS = (
          'all'        => [ @EXPORT_OK ],
          'DomainMask' => [ grep { /^NS.*DomainMask/ } @EXPORT_OK ],
          'Directory'  => [ grep { /^NS.*Directory/  } @EXPORT_OK ],
      );
  
      require Exporter;
      *import = \&Exporter::import;
  }
  
  1;
  __END__
  
  =head1 NAME
  
  Mac::SystemDirectory - Locate Mac OS X Standard System Directories
  
  =head1 SYNOPSIS
  
    use Mac::SystemDirectory qw[:all];
    
    $path = FindDirectory(NSDocumentDirectory);
    $path = HomeDirectory();
    $path = TemporaryDirectory();
  
  =head1 DESCRIPTION
  
  Locate Mac OS X Standard System Directories
  
  =head1 FUNCTIONS
  
  =over 4
  
  =item FindDirectory(Directory [, DomainMask])
  
  Creates a list of path strings for the specified directories in the specified 
  domains. The list is in the order in which you should search the directories.
  
  I<Usage>
  
      $path  = FindDirectory(NSApplicationDirectory);
      @paths = FindDirectory(NSApplicationDirectory);
  
  I<Arguments>
  
  =over 4
  
  =item Directory
  
  L</Directory> constant.
  
  =item DomainMask (optional)
  
  L</DomainMask> constant. Defaults to C<NSUserDomainMask>.
  
  =back
  
  I<Returns>
  
  When called in scalar context this function returns the first matching 
  directory. In list context it returns all matching directories.
  If no directories are found, undef is returned in a scalar context and an 
  empty list in a list context.
  
  =item HomeDirectory()
  
  Path to the current user's home directory.
  
  I<Usage>
  
      $path = HomeDirectory();
  
  I<Returns>
  
  A string containing the path of the current user's home directory.
  
  =item TemporaryDirectory()
  
  Path to the current user's temporary directory.
  
  I<Usage>
  
      $path = TemporaryDirectory();
  
  I<Returns>
  
  A string containing the path of the temporary directory for the current user. 
  If no such directory is currently available, returns undef.
  
  =back
  
  =head1 CONSTANTS
  
  =head2 DomainMask
  
  Bitmask constants that identify the file-system domain (User, System, Local, Network) or all domains.
  
  =over 4
  
  =item NSUserDomainMask
  
  The user's home directory-the place to install user's personal items (~).
  
  Available in Mac OS X v10.0 and later.
  
  =item NSLocalDomainMask
  
  Local to the current machine-the place to install items available to everyone on this machine.
  
  Available in Mac OS X v10.0 and later.
  
  =item NSNetworkDomainMask
  
  Publicly available location in the local area network-the place to install items available on the network (/Network).
  
  Available in Mac OS X v10.0 and later.
  
  =item NSSystemDomainMask
  
  Provided by Apple - can't be modified (/System).
  
  Available in Mac OS X v10.0 and later.
  
  =item NSAllDomainsMask
  
  All domains. Includes all of the above and future items.
  
  Available in Mac OS X v10.0 and later.
  
  =back
  
  =head2 Directory
  
  Constants that identify the name or type of directory (for example, Library, Documents, or Applications).
  
  =over 4
  
  =item NSApplicationDirectory
  
  Supported applications (/Applications).
  
  Available in Mac OS X v10.0 and later.
  
  =item NSDemoApplicationDirectory
  
  Unsupported applications and demonstration versions.
  
  Available in Mac OS X v10.0 and later.
  
  =item NSDeveloperApplicationDirectory
  
  Developer applications (/Developer/Applications).
  
  Available in Mac OS X v10.0 and later.
  
  =item NSAdminApplicationDirectory
  
  System and network administration applications.
  
  Available in Mac OS X v10.0 and later.
  
  =item NSLibraryDirectory
  
  Various user-visible documentation, support, and configuration files (/Library).
  
  Available in Mac OS X v10.0 and later.
  
  =item NSDeveloperDirectory
  
  Developer resources (/Developer).
  Deprecated: Beginning with Xcode 3.0, developer tools can be installed in any location.
  
  Available in Mac OS X v10.0 and later.
  
  =item NSUserDirectory
  
  User home directories (/Users).
  
  Available in Mac OS X v10.0 and later.
  
  =item NSDocumentationDirectory
  
  Documentation.
  
  Available in Mac OS X v10.0 and later.
  
  =item NSDocumentDirectory
  
  Document directory.
  
  Available in Mac OS X v10.2 and later.
  
  =item NSCoreServiceDirectory
  
  Location of core services (System/Library/CoreServices).
  
  Available in Mac OS X v10.4 and later.
  
  =item NSAutosavedInformationDirectory
  
  Location of user's autosaved documents Documents/Autosaved
  
  Available in Mac OS X v10.6 and later.
  
  =item NSDesktopDirectory
  
  Location of user's desktop directory.
  
  Available in Mac OS X v10.4 and later.
  
  =item NSCachesDirectory
  
  Location of discardable cache files (Library/Caches).
  
  Available in Mac OS X v10.4 and later.
  
  =item NSApplicationSupportDirectory
  
  Location of application support files (Library/Application Support).
  
  Available in Mac OS X v10.4 and later.
  
  =item NSDownloadsDirectory
  
  Location of the user's downloads directory.
  
  Available in Mac OS X v10.5 and later.
  
  =item NSInputMethodsDirectory
  
  Location of Input Methods (Library/Input Methods)
  
  Available in Mac OS X v10.6 and later.
  
  =item NSMoviesDirectory
  
  Location of user's Movies directory (~/Movies)
  
  Available in Mac OS X v10.6 and later.
  
  =item NSMusicDirectory
  
  Location of user's Movies directory (~/Music)
  
  Available in Mac OS X v10.6 and later.
  
  =item NSPicturesDirectory
  
  Location of user's Movies directory (~/Pictures)
  
  Available in Mac OS X v10.6 and later.
  
  =item NSPrinterDescriptionDirectory
  
  Location of system's PPDs directory (Library/Printers/PPDs)
  
  Available in Mac OS X v10.6 and later.
  
  =item NSSharedPublicDirectory
  
  Location of user's Public sharing directory (~/Public)
  
  Available in Mac OS X v10.6 and later.
  
  =item NSPreferencePanesDirectory
  
  Location of the PreferencePanes directory for use with System Preferences (Library/PreferencePanes)
  
  Available in Mac OS X v10.6 and later.
  
  =item NSItemReplacementDirectory
  
  For use with NSFileManager method URLForDirectory:inDomain:appropriateForURL:create:error:
  
  Available in Mac OS X v10.6 and later.
  
  =item NSAllApplicationsDirectory
  
  All directories where applications can occur.
  
  Available in Mac OS X v10.0 and later.
  
  =item NSAllLibrariesDirectory
  
  All directories where resources can occur.
  
  Available in Mac OS X v10.0 and later.
  
  =back
  
  =head1 EXPORT
  
  None by default. Functions and constants can either be imported individually or
  in sets grouped by tag names. The tag names are:
  
  =over 4
  
  =item C<:all> exports all functions and constants.
  
  =item C<:DomainMask> exports all L</DomainMask> constants.
  
  =item C<:Directory> exports all L</Directory> constants.
  
  =back
  
  =head1 SEE ALSO
  
  L<http://developer.apple.com/mac/library/DOCUMENTATION/Cocoa/Conceptual/LowLevelFileMgmt/Articles/StandardDirectories.html>
  L<http://developer.apple.com/mac/library/documentation/MacOSX/Conceptual/BPFileSystem/BPFileSystem.html>
  
  =head1 AUTHOR
  
  Christian Hansen, E<lt>chansen@cpan.orgE<gt>
  
  =head1 COPYRIGHT AND LICENSE
  
  Copyright (C) 2009 by Christian Hansen
  
  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.9 or,
  at your option, any later version of Perl 5 you may have available.
  
  =cut
DARWIN-2LEVEL_MAC_SYSTEMDIRECTORY

$fatpacked{"darwin-2level/Scalar/Util.pm"} = <<'DARWIN-2LEVEL_SCALAR_UTIL';
  # Copyright (c) 1997-2007 Graham Barr <gbarr@pobox.com>. All rights reserved.
  # This program is free software; you can redistribute it and/or
  # modify it under the same terms as Perl itself.
  #
  # Maintained since 2013 by Paul Evans <leonerd@leonerd.org.uk>
  
  package Scalar::Util;
  
  use strict;
  require Exporter;
  require List::Util; # List::Util loads the XS
  
  our @ISA       = qw(Exporter);
  our @EXPORT_OK = qw(
    blessed refaddr reftype weaken unweaken isweak
  
    dualvar isdual isvstring looks_like_number openhandle readonly set_prototype tainted
  );
  our $VERSION    = "1.38";
  $VERSION   = eval $VERSION;
  
  our @EXPORT_FAIL;
  
  unless (defined &weaken) {
    push @EXPORT_FAIL, qw(weaken);
  }
  unless (defined &isweak) {
    push @EXPORT_FAIL, qw(isweak isvstring);
  }
  unless (defined &isvstring) {
    push @EXPORT_FAIL, qw(isvstring);
  }
  
  sub export_fail {
    if (grep { /^(?:weaken|isweak)$/ } @_ ) {
      require Carp;
      Carp::croak("Weak references are not implemented in the version of perl");
    }
  
    if (grep { /^isvstring$/ } @_ ) {
      require Carp;
      Carp::croak("Vstrings are not implemented in the version of perl");
    }
  
    @_;
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  Scalar::Util - A selection of general-utility scalar subroutines
  
  =head1 SYNOPSIS
  
      use Scalar::Util qw(blessed dualvar isdual readonly refaddr reftype
                          tainted weaken isweak isvstring looks_like_number
                          set_prototype);
                          # and other useful utils appearing below
  
  =head1 DESCRIPTION
  
  C<Scalar::Util> contains a selection of subroutines that people have expressed
  would be nice to have in the perl core, but the usage would not really be high
  enough to warrant the use of a keyword, and the size so small such that being
  individual extensions would be wasteful.
  
  By default C<Scalar::Util> does not export any subroutines.
  
  =cut
  
  =head1 FUNCTIONS FOR REFERENCES
  
  The following functions all perform some useful activity on reference values.
  
  =head2 $pkg = blessed( $ref )
  
  If C<$ref> is a blessed reference the name of the package that it is blessed
  into is returned. Otherwise C<undef> is returned.
  
      $scalar = "foo";
      $class  = blessed $scalar;           # undef
  
      $ref    = [];
      $class  = blessed $ref;              # undef
  
      $obj    = bless [], "Foo";
      $class  = blessed $obj;              # "Foo"
  
  Take care when using this function simply as a truth test (such as in
  C<if(blessed $ref)...>) because the package name C<"0"> is defined yet false.
  
  =head2 $addr = refaddr( $ref )
  
  If C<$ref> is reference the internal memory address of the referenced value is
  returned as a plain integer. Otherwise C<undef> is returned.
  
      $addr = refaddr "string";           # undef
      $addr = refaddr \$var;              # eg 12345678
      $addr = refaddr [];                 # eg 23456784
  
      $obj  = bless {}, "Foo";
      $addr = refaddr $obj;               # eg 88123488
  
  =head2 $type = reftype( $ref )
  
  If C<$ref> is a reference the basic Perl type of the variable referenced is
  returned as a plain string (such as C<ARRAY> or C<HASH>). Otherwise C<undef>
  is returned.
  
      $type = reftype "string";           # undef
      $type = reftype \$var;              # SCALAR
      $type = reftype [];                 # ARRAY
  
      $obj  = bless {}, "Foo";
      $type = reftype $obj;               # HASH
  
  =head2 weaken( REF )
  
  The lvalue C<REF> will be turned into a weak reference. This means that it
  will not hold a reference count on the object it references. Also when the
  reference count on that object reaches zero, the reference will be set to
  undef. This function mutates the lvalue passed as its argument and returns no
  value.
  
  This is useful for keeping copies of references, but you don't want to prevent
  the object being DESTROY-ed at its usual time.
  
      {
        my $var;
        $ref = \$var;
        weaken($ref);                     # Make $ref a weak reference
      }
      # $ref is now undef
  
  Note that if you take a copy of a scalar with a weakened reference, the copy
  will be a strong reference.
  
      my $var;
      my $foo = \$var;
      weaken($foo);                       # Make $foo a weak reference
      my $bar = $foo;                     # $bar is now a strong reference
  
  This may be less obvious in other situations, such as C<grep()>, for instance
  when grepping through a list of weakened references to objects that may have
  been destroyed already:
  
      @object = grep { defined } @object;
  
  This will indeed remove all references to destroyed objects, but the remaining
  references to objects will be strong, causing the remaining objects to never be
  destroyed because there is now always a strong reference to them in the @object
  array.
  
  =head2 unweaken( REF )
  
  The lvalue C<REF> will be turned from a weak reference back into a normal
  (strong) reference again. This function mutates the lvalue passed as its
  argument and returns no value. This undoes the action performed by
  C<weaken()>.
  
  This function is slightly neater and more convenient than the
  otherwise-equivalent code
  
      my $tmp = $REF;
      undef $REF;
      $REF = $tmp;
  
  (because in particular, simply assigning a weak reference back to itself does
  not work to unweaken it; C<$REF = $REF> does not work).
  
  =head2 $weak = isweak( $ref )
  
  Returns true if C<$ref> is a weak reference.
  
      $ref  = \$foo;
      $weak = isweak($ref);               # false
      weaken($ref);
      $weak = isweak($ref);               # true
  
  B<NOTE>: Copying a weak reference creates a normal, strong, reference.
  
      $copy = $ref;
      $weak = isweak($copy);              # false
  
  =head1 OTHER FUNCTIONS
  
  =head2 $var = dualvar( $num, $string )
  
  Returns a scalar that has the value C<$num> in a numeric context and the value
  C<$string> in a string context.
  
      $foo = dualvar 10, "Hello";
      $num = $foo + 2;                    # 12
      $str = $foo . " world";             # Hello world
  
  =head2 $dual = isdual( $var )
  
  If C<$var> is a scalar that has both numeric and string values, the result is
  true.
  
      $foo = dualvar 86, "Nix";
      $dual = isdual($foo);               # true
  
  Note that a scalar can be made to have both string and numeric content through
  numeric operations:
  
      $foo = "10";
      $dual = isdual($foo);               # false
      $bar = $foo + 0;
      $dual = isdual($foo);               # true
  
  Note that although C<$!> appears to be dual-valued variable, it is actually
  implemented using a tied scalar:
  
      $! = 1;
      print("$!\n");                      # "Operation not permitted"
      $dual = isdual($!);                 # false
  
  You can capture its numeric and string content using:
  
      $err = dualvar $!, $!;
      $dual = isdual($err);               # true
  
  =head2 $vstring = isvstring( $var )
  
  If C<$var> is a scalar which was coded as a vstring the result is true.
  
      $vs   = v49.46.48;
      $fmt  = isvstring($vs) ? "%vd" : "%s"; #true
      printf($fmt,$vs);
  
  =head2 $isnum = looks_like_number( $var )
  
  Returns true if perl thinks C<$var> is a number. See
  L<perlapi/looks_like_number>.
  
  =head2 $fh = openhandle( $fh )
  
  Returns C<$fh> itself if C<$fh> may be used as a filehandle and is open, or is
  is a tied handle. Otherwise C<undef> is returned.
  
      $fh = openhandle(*STDIN);           # \*STDIN
      $fh = openhandle(\*STDIN);          # \*STDIN
      $fh = openhandle(*NOTOPEN);         # undef
      $fh = openhandle("scalar");         # undef
  
  =head2 $ro = readonly( $var )
  
  Returns true if C<$var> is readonly.
  
      sub foo { readonly($_[0]) }
  
      $readonly = foo($bar);              # false
      $readonly = foo(0);                 # true
  
  =head2 $code = set_prototype( $code, $prototype )
  
  Sets the prototype of the function given by the C<$code> reference, or deletes
  it if C<$prototype> is C<undef>. Returns the C<$code> reference itself.
  
      set_prototype \&foo, '$$';
  
  =head2 $t = tainted( $var )
  
  Return true if C<$var> is tainted.
  
      $taint = tainted("constant");       # false
      $taint = tainted($ENV{PWD});        # true if running under -T
  
  =head1 DIAGNOSTICS
  
  Module use may give one of the following errors during import.
  
  =over
  
  =item Weak references are not implemented in the version of perl
  
  The version of perl that you are using does not implement weak references, to
  use C<isweak> or C<weaken> you will need to use a newer release of perl.
  
  =item Vstrings are not implemented in the version of perl
  
  The version of perl that you are using does not implement Vstrings, to use
  C<isvstring> you will need to use a newer release of perl.
  
  =item C<NAME> is only available with the XS version of Scalar::Util
  
  C<Scalar::Util> contains both perl and C implementations of many of its
  functions so that those without access to a C compiler may still use it.
  However some of the functions are only available when a C compiler was
  available to compile the XS version of the extension.
  
  At present that list is: weaken, isweak, dualvar, isvstring, set_prototype
  
  =back
  
  =head1 KNOWN BUGS
  
  There is a bug in perl5.6.0 with UV's that are >= 1<<31. This will
  show up as tests 8 and 9 of dualvar.t failing
  
  =head1 SEE ALSO
  
  L<List::Util>
  
  =head1 COPYRIGHT
  
  Copyright (c) 1997-2007 Graham Barr <gbarr@pobox.com>. All rights reserved.
  This program is free software; you can redistribute it and/or modify it
  under the same terms as Perl itself.
  
  Except weaken and isweak which are
  
  Copyright (c) 1999 Tuomas J. Lukka <lukka@iki.fi>. All rights reserved.
  This program is free software; you can redistribute it and/or modify it
  under the same terms as perl itself.
  
  =cut
DARWIN-2LEVEL_SCALAR_UTIL

s/^  //mg for values %fatpacked;

unshift @INC, sub {
  if (my $fat = $fatpacked{$_[1]}) {
    if ($] < 5.008) {
      return sub {
        return 0 unless length $fat;
        $fat =~ s/^([^\n]*\n?)//;
        $_ = $1;
        return 1;
      };
    }
    open my $fh, '<', \$fat
      or die "FatPacker error loading $_[1] (could be a perl installation issue?)";
    return $fh;
  }
  return
};

} # END OF FATPACK CODE


use Data::Printer;