Help language development. Donate to The Perl Foundation

FindBin cpan:LEMBARK last updated on 2019-09-14

lib/FindBin.pm6
########################################################################
# housekeeping
########################################################################

use v6.d;

unit module FindBin:ver<0.4.5>:auth<CPAN:lembark>;

# constants are exported into caller's space via use,
# supply context defaults for args in Bin & Script.

constant _FindBin_RESOLVE-DEF is export( :resolve ) = True;
constant _FindBin_VERBOSE-DEF is export( :verbose ) = True;

constant OPTION-TAGS    = |( :resolve, :verbose );

# decided once at use time, no reson to re-compute it:

constant IS-INTERACTIVE 
= $*PROGRAM-NAME eq '-e' | '-' | 'interactive';

################################################################
# exported (API)
################################################################

# Bool() => typed or undef, avoids Nil on not-installed constant
# causing parameter error if "Bool" is used.
#
# Note: 
# resolve returns an IO.
# absolute returns a string.
# dirname returns a string.

sub Script 
(
  Bool() :$resolve = CALLER::CALLER::LEXICAL::_FindBin_RESOLVE-DEF,
  Bool() :$verbose = CALLER::CALLER::LEXICAL::_FindBin_VERBOSE-DEF
)
is export( :Script, :DEFAULT, OPTION-TAGS )
{
  if $verbose
  {
    note '# Script()';
    note "# Interactive: '{IS-INTERACTIVE}'";
    note "# Resolve:     $resolve";
    note "# Path:        '$*PROGRAM-NAME'";
  }

  IS-INTERACTIVE
  ?? ~$*PROGRAM-NAME
  !! $resolve
  ?? $*PROGRAM.resolve( completely => True ).basename
  !! $*PROGRAM.basename
}

sub Bin
(
    Bool() :$resolve = CALLER::CALLER::LEXICAL::_FindBin_RESOLVE-DEF
  , Bool() :$verbose = CALLER::CALLER::LEXICAL::_FindBin_VERBOSE-DEF
  --> IO
)
is export( :Bin, :DEFAULT, OPTION-TAGS )
{
  my $bin_from
  =  IS-INTERACTIVE 
  ?? $*CWD 
  !! $*PROGRAM.IO
  ;

  my $path 
  = $resolve
  ?? $bin_from.resolve( completely => True )
  !! $bin_from.absolute.IO
  ;

  if $verbose
  {
    note '# Bin()';
    note "# Interactive: '{IS-INTERACTIVE}'";
    note "# Resolve:     '$resolve";
    note "# Bin from:    '$bin_from'";
    note "# Path is:     '$path'";
  }

  # interactive based on CWD returns the directory
  # as-is, otherwise return the executable path's
  # directory.

  IS-INTERACTIVE
  ?? $path
  !! $path.parent
}