view release on metacpan or  search on metacpan

bin/stow  view on Meta::CPAN

#=============================================================================
sub expand_filepath {
    my ($path, $source) = @_;

    $path = expand_environment($path, $source);
    $path = expand_tilde($path);

    return $path;
}

#===== SUBROUTINE ============================================================
# Name      : expand_environment()
# Purpose   : Expands evironment variables.
# Parameters: $path => string to perform expansion on.
#           : $source => where the string came from
# Returns   : String with replacements performed.
# Throws    : n/a
# Comments  : Variable replacement mostly based on SO answer
#           : http://stackoverflow.com/a/24675093/558820
#=============================================================================
sub expand_environment {
    my ($path, $source) = @_;
    # Replace non-escaped $VAR and ${VAR} with $ENV{VAR}
    # If $ENV{VAR} does not exist, perl will raise a warning
    # and then happily treat it as an empty string.
    $path =~ s/(?<!\\)\$\{((?:\w|\s)+)\}/
               _safe_expand_env_var($1, $source)
              /ge;
    $path =~ s/(?<!\\)\$(\w+)/
               _safe_expand_env_var($1, $source)
              /ge;
    # Remove \$ escapes.
    $path =~ s/\\\$/\$/g;
    return $path;
}

sub _safe_expand_env_var {
    my ($var, $source) = @_;
    unless (exists $ENV{$var}) {
        die "$source references undefined environment variable \$$var; " .
            "aborting!\n";
    }
    return $ENV{$var};
}

#===== SUBROUTINE ============================================================
# Name      : expand_tilde()
# Purpose   : Expands tilde to user's home directory path.
# Parameters: $path => string to perform expansion on.
# Returns   : String with replacements performed.
# Throws    : n/a
# Comments  : http://docstore.mik.ua/orelly/perl4/cook/ch07_04.htm
#=============================================================================
sub expand_tilde {
    my ($path) = @_;
    # Replace tilde with home path.
	$path =~ s{ ^ ~ ( [^/]* ) }
                  { $1
                    ? (getpwnam($1))[7]
                    : ( $ENV{HOME} || $ENV{LOGDIR}
                         || (getpwuid($<))[7]
                      )
    }ex;
    # Replace espaced tilde with regular tilde.
    $path =~ s/\\~/~/g;
	return $path
}


#===== SUBROUTINE ===========================================================
# Name      : usage()
# Purpose   : print program usage message and exit
# Parameters: $msg => string to prepend to the usage message
# Returns   : n/a
# Throws    : n/a
# Comments  : if 'msg' is given, then exit with non-zero status
#============================================================================
sub usage {
    my ($msg) = @_;

    if ($msg) {
        warn "$ProgramName: $msg\n\n";
    }

    print <<"EOT";
$ProgramName (GNU Stow) version $Stow::VERSION

SYNOPSIS:

    $ProgramName [OPTION ...] [-D|-S|-R] PACKAGE ... [-D|-S|-R] PACKAGE ...

OPTIONS:

    -d DIR, --dir=DIR     Set stow dir to DIR (default is current dir)
    -t DIR, --target=DIR  Set target to DIR (default is parent of stow dir)

    -S, --stow            Stow the package names that follow this option
    -D, --delete          Unstow the package names that follow this option
    -R, --restow          Restow (like stow -D followed by stow -S)

    --ignore=REGEX        Ignore files ending in this Perl regex
    --defer=REGEX         Don't stow files beginning with this Perl regex
                          if the file is already stowed to another package
    --override=REGEX      Force stowing files beginning with this Perl regex
                          if the file is already stowed to another package
    --adopt               (Use with care!)  Import existing files into stow package
                          from target.  Please read docs before using.
    --dotfiles            Enables special handling for dotfiles that are
                          Stow packages that start with "dot-" and not "."
    -p, --compat          Use legacy algorithm for unstowing

    -n, --no, --simulate  Do not actually make any filesystem changes
    -v, --verbose[=N]     Increase verbosity (levels are from 0 to 5;
                            -v or --verbose adds 1; --verbose=N sets level)
    -V, --version         Show stow version number
    -h, --help            Show this help

Report bugs to: bug-stow\@gnu.org
Stow home page: <http://www.gnu.org/software/stow/>
General help using GNU software: <http://www.gnu.org/gethelp/>
EOT