view release on metacpan or  search on metacpan

lib/Path/This.pm  view on Meta::CPAN

package Path::This;

use strict;
use warnings;
use Carp ();
use Cwd ();
use File::Basename ();
use Sub::Util ();

our $VERSION = '0.005';

sub THISFILE () { Cwd::abs_path((caller)[1]) }
sub THISDIR () {
  my $file = (caller)[1];
  return -e $file ? File::Basename::dirname(Cwd::abs_path $file) : Cwd::getcwd;
}

sub import {
  my $class = shift;
  my ($package, $file) = caller;

  my ($abs_file, $abs_dir);
  foreach my $item (@_) {
    if ($item =~ m/\A([&\$])?THISFILE\z/) {
      my $symbol = $1;
      unless (defined $abs_file) {
        $abs_file = Cwd::abs_path $file;
      }
      if (!$symbol) {
        my $const_file = $abs_file;
        no strict 'refs';
        no warnings 'redefine';
        *{"${package}::THISFILE"} = \&{Sub::Util::set_subname
          "${package}::THISFILE", sub () { $const_file }};
      } elsif ($symbol eq '&') {
        no strict 'refs';
        no warnings 'redefine';
        *{"${package}::THISFILE"} = \&THISFILE;
      } elsif ($symbol eq '$') {
        no strict 'refs';
        *{"${package}::THISFILE"} = \$abs_file;
      }
    } elsif ($item =~ m/\A([&\$])?THISDIR\z/) {
      my $symbol = $1;
      unless (defined $abs_dir) {
        $abs_dir = defined $abs_file ? File::Basename::dirname($abs_file)
          : -e $file ? File::Basename::dirname($abs_file = Cwd::abs_path $file)
          : Cwd::getcwd;
      }
      if (!$symbol) {
        my $const_dir = $abs_dir;
        no strict 'refs';
        no warnings 'redefine';
        *{"${package}::THISDIR"} = \&{Sub::Util::set_subname
          "${package}::THISDIR", sub () { $const_dir }};
      } elsif ($symbol eq '&') {
        no strict 'refs';
        no warnings 'redefine';
        *{"${package}::THISDIR"} = \&THISDIR;
      } elsif ($symbol eq '$') {
        no strict 'refs';
        *{"${package}::THISDIR"} = \$abs_dir;
      }
    } else {
      Carp::croak qq{"$item" is not exported by the $class module};
    }
  }
}

1;

=head1 NAME

Path::This - Path to this source file or directory