From ba476968336f8a1eab5d567d43eb1a525c2937a1 Mon Sep 17 00:00:00 2001 From: Dave Rolsky Date: Sun, 8 Sep 2024 11:28:52 -0500 Subject: [PATCH] Add tests for this action --- .github/workflows/test.yml | 57 + .gitignore | 2 +- test-project/Cargo.lock | 7 + test-project/Cargo.toml | 27 + test-project/src/bin1.rs | 11 + test-project/src/bin2.rs | 11 + tests/check-release.pl | 74 + tests/lib/IPC/System/Simple.pm | 1115 +++++++++ tests/lib/Path/Tiny.pm | 3880 ++++++++++++++++++++++++++++++++ 9 files changed, 5183 insertions(+), 1 deletion(-) create mode 100644 .github/workflows/test.yml create mode 100644 test-project/Cargo.lock create mode 100644 test-project/Cargo.toml create mode 100644 test-project/src/bin1.rs create mode 100644 test-project/src/bin2.rs create mode 100755 tests/check-release.pl create mode 100644 tests/lib/IPC/System/Simple.pm create mode 100644 tests/lib/Path/Tiny.pm diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml new file mode 100644 index 0000000..06ecb89 --- /dev/null +++ b/.github/workflows/test.yml @@ -0,0 +1,57 @@ +name: Self-test + +on: + push: + pull_request: + +jobs: + test: + name: Test + strategy: + fail-fast: false + matrix: + platform: + - platform_name: Linux-x86_64 + os: ubuntu-20.04 + target: x86_64-unknown-linux-musl + cache-cross-binary: true + - platform_name: Linux-powerpc64 + os: ubuntu-20.04 + target: powerpc64-unknown-linux-gnu + cache-cross-binary: true + - platform_name: Windows-x86_64 + os: windows-latest + target: x86_64-pc-windows-msvc + - platform_name: macOS-aarch64 + os: macOS-latest + target: aarch64-apple-darwin + + runs-on: ${{ matrix.platform.os }} + steps: + - name: Checkout + uses: actions/checkout@v4 + - name: Copy test project to root + shell: bash + run: | + cp -a test-project/* . + rm -fr test-project + - name: Build binary + uses: actions-rust-cross@v0 + with: + command: build + target: ${{ matrix.platform.target }} + GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} + - name: Release + id: release + uses: . + with: + binary-name: test-project + target: ${{ matrix.platform.target }} + - name: Check release artifacts + shell: bash + run: | + tests/check-release.pl \ + --artifact-id ${{ steps.release.outputs.artifact-id }}" \ + --binary-name test-project \ + --repo houseabsolute/actions-rust-release \ + --target "${{ matrix.platform.target }}" diff --git a/.gitignore b/.gitignore index 8f5415d..d87531b 100644 --- a/.gitignore +++ b/.gitignore @@ -3,4 +3,4 @@ /package.json .\#* \#*\# - +test-project/**/target/** diff --git a/test-project/Cargo.lock b/test-project/Cargo.lock new file mode 100644 index 0000000..6e82782 --- /dev/null +++ b/test-project/Cargo.lock @@ -0,0 +1,7 @@ +# This file is automatically @generated by Cargo. +# It is not intended for manual editing. +version = 3 + +[[package]] +name = "test-project" +version = "0.1.0" diff --git a/test-project/Cargo.toml b/test-project/Cargo.toml new file mode 100644 index 0000000..411ea58 --- /dev/null +++ b/test-project/Cargo.toml @@ -0,0 +1,27 @@ +[package] +name = "test-project" +version = "0.1.0" +edition = "2021" + +# For testing it would be nice to create a binary with spaces in the name, but +# right now the `name` value must be a valid crate name, and there's no +# separate setting for the compiled executable's name. See +# https://github.com/rust-lang/cargo/issues/9778. +[[bin]] +name = "bin1" +path = "src/bin1.rs" + +[[bin]] +name = "bin2" +path = "src/bin2.rs" + +# workaround for https://github.com/cross-rs/cross/issues/1345 +[package.metadata.cross.target.x86_64-unknown-netbsd] +pre-build = [ + "mkdir -p /tmp/netbsd", + "curl https://cdn.netbsd.org/pub/NetBSD/NetBSD-9.2/amd64/binary/sets/base.tar.xz -O", + "tar -C /tmp/netbsd -xJf base.tar.xz", + "cp /tmp/netbsd/usr/lib/libexecinfo.so /usr/local/x86_64-unknown-netbsd/lib", + "rm base.tar.xz", + "rm -rf /tmp/netbsd", +] diff --git a/test-project/src/bin1.rs b/test-project/src/bin1.rs new file mode 100644 index 0000000..b80f5b7 --- /dev/null +++ b/test-project/src/bin1.rs @@ -0,0 +1,11 @@ +fn main() { + println!("Hello, world!"); +} + +#[cfg(test)] +mod test { + #[test] + fn test_something() { + assert_eq!(1, 1); + } +} diff --git a/test-project/src/bin2.rs b/test-project/src/bin2.rs new file mode 100644 index 0000000..b80f5b7 --- /dev/null +++ b/test-project/src/bin2.rs @@ -0,0 +1,11 @@ +fn main() { + println!("Hello, world!"); +} + +#[cfg(test)] +mod test { + #[test] + fn test_something() { + assert_eq!(1, 1); + } +} diff --git a/tests/check-release.pl b/tests/check-release.pl new file mode 100755 index 0000000..98bcbcb --- /dev/null +++ b/tests/check-release.pl @@ -0,0 +1,74 @@ +#!/usr/bin/env perl + +use v5.30; +use strict; +use warnings; +no warnings 'experimental::signatures'; +use feature 'signatures'; +use autodie qw( :all ); + +use FindBin qw( $Bin ); +use File::Spec; +use lib File::Spec->catdir( $Bin, 'lib' ); + +use Getopt::Long; +use IPC::System::Simple qw( capturex ); +use Test::More; + +sub main { + my $artifact_id; + my $binary_name; + my $repo; + my $target; + + GetOptions( + 'artifact-id=s' => \$artifact_id, + 'binary-name=s' => \$binary_name, + 'repo=s' => \$repo, + 'target=s' => \$target, + ); + + system( + 'curl', + '-L', + '-H', 'Accept: application/vnd.github+json', + '-H', "Authorization: Bearer $ENV{GITHUB_TOKEN}", + '-o', 'artifact.zip', + "https://api.github.com/repos/$repo/actions/artifacts/$artifact_id/zip", + ); + + system( 'unzip', 'artifact.zip' ); + + my $glob = $target =~ /windows/i ? '*.zip*' : '*.tar.gz*'; + my @files = glob $glob; + + is( scalar @files, 2, 'found two files in the artifact tarball' ); + my ($archive_file) = grep { !/sha256/ } @files; + my ($checksum_file) = grep {/sha256/} @files; + + ok( $archive_file, 'found an archive file in the artifact tarball' ); + ok( $checksum_file, 'found a checksum file in the artifact tarball' ); + + open my $fh, '<', $checksum_file; + my $sha256_contents = do { local $/; <$fh> }; + $sha256_contents =~ s/^\s+|\s+$//g; + my ( $checksum, $filename ) = $sha256_contents =~ /^(\S+) (\S+)$/; + is( $filename, $archive_file, "filename in checksum file matches archive filename" ); + my $output = capturex( 'sha256sum', '--check', $checksum_file ); + like( $output, qr/\Q$archive_file\E: OK/, 'sha256sum reports checksum is OK' ); + + if ( $archive_file =~ /\.zip$/ ) { + system( 'unzip', $archive_file ); + } + else { + system( 'tar', 'xzf', $archive_file ); + } + + for my $file ( $binary_name, qw( README.md Changes.md ) ) { + ok( -f $file, "$file exists after unpacking archive" ); + } + + done_testing(); +} + +main(); diff --git a/tests/lib/IPC/System/Simple.pm b/tests/lib/IPC/System/Simple.pm new file mode 100644 index 0000000..c869862 --- /dev/null +++ b/tests/lib/IPC/System/Simple.pm @@ -0,0 +1,1115 @@ +package IPC::System::Simple; + +# ABSTRACT: Run commands simply, with detailed diagnostics + +use 5.006; +use strict; +use warnings; +use re 'taint'; +use Carp; +use List::Util qw(first); +use Scalar::Util qw(tainted); +use Config; +use constant WINDOWS => ($^O eq 'MSWin32'); +use constant VMS => ($^O eq 'VMS'); + +BEGIN { + + # It would be lovely to use the 'if' module here, but it didn't + # enter core until 5.6.2, and we want to keep 5.6.0 compatibility. + + + if (WINDOWS) { + + ## no critic (ProhibitStringyEval) + + eval q{ + use Win32::Process qw(INFINITE NORMAL_PRIORITY_CLASS); + use File::Spec; + use Win32; + use Win32::ShellQuote; + + # This uses the same rules as the core win32.c/get_shell() call. + use constant WINDOWS_SHELL => eval { Win32::IsWinNT() } + ? [ File::Spec->catfile(Win32::GetFolderPath(Win32::CSIDL_SYSTEM), 'cmd.exe'), '/x/d/c' ] + : [ File::Spec->catfile(Win32::GetFolderPath(Win32::CSIDL_SYSTEM), 'command.com'), '/c' ]; + + # These are used when invoking _win32_capture + use constant NO_SHELL => 0; + use constant USE_SHELL => 1; + + }; + + ## use critic + + # Die nosily if any of the above broke. + die $@ if $@; + } +} + +# Note that we don't use WIFSTOPPED because perl never uses +# the WUNTRACED flag, and hence will never return early from +# system() if the child processes is suspended with a SIGSTOP. + +use POSIX qw(WIFEXITED WEXITSTATUS WIFSIGNALED WTERMSIG); + +use constant FAIL_START => q{"%s" failed to start: "%s"}; +use constant FAIL_PLUMBING => q{Error in IPC::System::Simple plumbing: "%s" - "%s"}; +use constant FAIL_CMD_BLANK => q{Entirely blank command passed: "%s"}; +use constant FAIL_INTERNAL => q{Internal error in IPC::System::Simple: "%s"}; +use constant FAIL_TAINT => q{%s called with tainted argument "%s"}; +use constant FAIL_TAINT_ENV => q{%s called with tainted environment $ENV{%s}}; +use constant FAIL_SIGNAL => q{"%s" died to signal "%s" (%d)%s}; +use constant FAIL_BADEXIT => q{"%s" unexpectedly returned exit value %d}; + +use constant FAIL_UNDEF => q{%s called with undefined command}; + + +use constant FAIL_POSIX => q{IPC::System::Simple does not understand the POSIX error '%s'. Please check https://metacpan.org/pod/IPC::System::Simple to see if there is an updated version. If not please report this as a bug to https://github.com/pjf/ipc-system-simple/issues}; + +# On Perl's older than 5.8.x we can't assume that there'll be a +# $^{TAINT} for us to check, so we assume that our args may always +# be tainted. +use constant ASSUME_TAINTED => ($] < 5.008); + +use constant EXIT_ANY_CONST => -1; # Used internally +use constant EXIT_ANY => [ EXIT_ANY_CONST ]; # Exported + +use constant UNDEFINED_POSIX_RE => qr{not (?:defined|a valid) POSIX macro|not implemented on this architecture}; + +require Exporter; +our @ISA = qw(Exporter); + +our @EXPORT_OK = qw( + capture capturex + run runx + system systemx + $EXITVAL EXIT_ANY +); + +our $VERSION = '1.30'; +$VERSION =~ tr/_//d; + +our $EXITVAL = -1; + +my @Signal_from_number = split(' ', $Config{sig_name}); + +# Environment variables we don't want to see tainted. +my @Check_tainted_env = qw(PATH IFS CDPATH ENV BASH_ENV); +if (WINDOWS) { + push(@Check_tainted_env, 'PERL5SHELL'); +} +if (VMS) { + push(@Check_tainted_env, 'DCL$PATH'); +} + +# Not all systems implement the WIFEXITED calls, but POSIX +# will always export them (even if they're just stubs that +# die with an error). Test for the presence of a working +# WIFEXITED and friends, or define our own. + +eval { WIFEXITED(0); }; + +if ($@ =~ UNDEFINED_POSIX_RE) { + no warnings 'redefine'; ## no critic + *WIFEXITED = sub { not $_[0] & 0xff }; + *WEXITSTATUS = sub { $_[0] >> 8 }; + *WIFSIGNALED = sub { $_[0] & 127 }; + *WTERMSIG = sub { $_[0] & 127 }; +} elsif ($@) { + croak sprintf FAIL_POSIX, $@; +} + +# None of the POSIX modules I've found define WCOREDUMP, although +# many systems define it. Check the POSIX module in the hope that +# it may actually be there. + + +# TODO: Ideally, $NATIVE_WCOREDUMP should be a constant. + +my $NATIVE_WCOREDUMP; + +eval { POSIX::WCOREDUMP(1); }; + +if ($@ =~ UNDEFINED_POSIX_RE) { + *WCOREDUMP = sub { $_[0] & 128 }; + $NATIVE_WCOREDUMP = 0; +} elsif ($@) { + croak sprintf FAIL_POSIX, $@; +} else { + # POSIX actually has it defined! Huzzah! + *WCOREDUMP = \&POSIX::WCOREDUMP; + $NATIVE_WCOREDUMP = 1; +} + +sub _native_wcoredump { + return $NATIVE_WCOREDUMP; +} + +# system simply calls run + +no warnings 'once'; ## no critic +*system = \&run; +*systemx = \&runx; +use warnings; + +# run is our way of running a process with system() semantics + +sub run { + + _check_taint(@_); + + my ($valid_returns, $command, @args) = _process_args(@_); + + # If we have arguments, we really want to call systemx, + # so we do so. + + if (@args) { + return systemx($valid_returns, $command, @args); + } + + if (WINDOWS) { + my $pid = _spawn_or_die(&WINDOWS_SHELL->[0], join ' ', @{&WINDOWS_SHELL}, $command); + $pid->Wait(INFINITE); # Wait for process exit. + $pid->GetExitCode($EXITVAL); + return _check_exit($command,$EXITVAL,$valid_returns); + } + + # Without arguments, we're calling system, and checking + # the results. + + # We're throwing our own exception on command not found, so + # we don't need a warning from Perl. + + { + # silence 'Statement unlikely to be reached' warning + no warnings 'exec'; ## no critic + CORE::system($command,@args); + } + + return _process_child_error($?,$command,$valid_returns); +} + +# runx is just like system/run, but *never* invokes the shell. + +sub runx { + _check_taint(@_); + + my ($valid_returns, $command, @args) = _process_args(@_); + + if (WINDOWS) { + our $EXITVAL = -1; + + my $pid = _spawn_or_die($command, Win32::ShellQuote::quote_native($command, @args)); + + $pid->Wait(INFINITE); # Wait for process exit. + $pid->GetExitCode($EXITVAL); + return _check_exit($command,$EXITVAL,$valid_returns); + } + + # If system() fails, we throw our own exception. We don't + # need to have perl complain about it too. + + no warnings; ## no critic + + CORE::system { $command } $command, @args; + + return _process_child_error($?, $command, $valid_returns); +} + +# capture is our way of running a process with backticks/qx semantics + +sub capture { + _check_taint(@_); + + my ($valid_returns, $command, @args) = _process_args(@_); + + if (@args) { + return capturex($valid_returns, $command, @args); + } + + if (WINDOWS) { + # USE_SHELL really means "You may use the shell if you need it." + return _win32_capture(USE_SHELL, $valid_returns, $command); + } + + our $EXITVAL = -1; + + my $wantarray = wantarray(); + + # We'll produce our own warnings on failure to execute. + no warnings 'exec'; ## no critic + + if ($wantarray) { + my @results = qx($command); + _process_child_error($?,$command,$valid_returns); + return @results; + } + + my $results = qx($command); + _process_child_error($?,$command,$valid_returns); + return $results; +} + +# _win32_capture implements the capture and capurex commands on Win32. +# We need to wrap the whole internals of this sub into +# an if (WINDOWS) block to avoid it being compiled on non-Win32 systems. + +sub _win32_capture { + if (not WINDOWS) { + croak sprintf(FAIL_INTERNAL, "_win32_capture called when not under Win32"); + } else { + + my ($use_shell, $valid_returns, $command, @args) = @_; + + my $wantarray = wantarray(); + + # Perl doesn't support multi-arg open under + # Windows. Perl also doesn't provide very good + # feedback when normal backtails fail, either; + # it returns exit status from the shell + # (which is indistinguishable from the command + # running and producing the same exit status). + + # As such, we essentially have to write our own + # backticks. + + # We start by dup'ing STDOUT. + + open(my $saved_stdout, '>&', \*STDOUT) ## no critic + or croak sprintf(FAIL_PLUMBING, "Can't dup STDOUT", $!); + + # We now open up a pipe that will allow us to + # communicate with the new process. + + pipe(my ($read_fh, $write_fh)) + or croak sprintf(FAIL_PLUMBING, "Can't create pipe", $!); + + # Allow CRLF sequences to become "\n", since + # this is what Perl backticks do. + + binmode($read_fh, ':crlf'); + + # Now we re-open our STDOUT to $write_fh... + + open(STDOUT, '>&', $write_fh) ## no critic + or croak sprintf(FAIL_PLUMBING, "Can't redirect STDOUT", $!); + + # If we have args, or we're told not to use the shell, then + # we treat $command as our shell. Otherwise we grub around + # in our command to look for a command to run. + # + # Note that we don't actually *use* the shell (although in + # a future version we might). Being told not to use the shell + # (capturex) means we treat our command as really being a command, + # and not a command line. + + my $exe = @args ? $command : + (! $use_shell) ? $command : + $command =~ m{^"([^"]+)"}x ? $1 : + $command =~ m{(\S+) }x ? $1 : + croak sprintf(FAIL_CMD_BLANK, $command); + + # And now we spawn our new process with inherited + # filehandles. + + my $err; + my $pid = eval { + _spawn_or_die($exe, @args ? Win32::ShellQuote::quote_native($command, @args) : $command); + } + or do { + $err = $@; + }; + + # Regardless of whether our command ran, we must restore STDOUT. + # RT #48319 + open(STDOUT, '>&', $saved_stdout) ## no critic + or croak sprintf(FAIL_PLUMBING,"Can't restore STDOUT", $!); + + # And now, if there was an actual error , propagate it. + die $err if defined $err; # If there's an error from _spawn_or_die + + # Clean-up the filehandles we no longer need... + + close($write_fh) + or croak sprintf(FAIL_PLUMBING,q{Can't close write end of pipe}, $!); + close($saved_stdout) + or croak sprintf(FAIL_PLUMBING,q{Can't close saved STDOUT}, $!); + + # Read the data from our child... + + my (@results, $result); + + if ($wantarray) { + @results = <$read_fh>; + } else { + $result = join("",<$read_fh>); + } + + # Tidy up our windows process and we're done! + + $pid->Wait(INFINITE); # Wait for process exit. + $pid->GetExitCode($EXITVAL); + + _check_exit($command,$EXITVAL,$valid_returns); + + return $wantarray ? @results : $result; + + } +} + +# capturex() is just like backticks/qx, but never invokes the shell. + +sub capturex { + _check_taint(@_); + + my ($valid_returns, $command, @args) = _process_args(@_); + + our $EXITVAL = -1; + + my $wantarray = wantarray(); + + if (WINDOWS) { + return _win32_capture(NO_SHELL, $valid_returns, $command, @args); + } + + # We can't use a multi-arg piped open here, since 5.6.x + # doesn't like them. Instead we emulate what 5.8.x does, + # which is to create a pipe(), set the close-on-exec flag + # on the child, and the fork/exec. If the exec fails, the + # child writes to the pipe. If the exec succeeds, then + # the pipe closes without data. + + pipe(my ($read_fh, $write_fh)) + or croak sprintf(FAIL_PLUMBING, "Can't create pipe", $!); + + # This next line also does an implicit fork. + my $pid = open(my $pipe, '-|'); ## no critic + + if (not defined $pid) { + croak sprintf(FAIL_START, $command, $!); + } elsif (not $pid) { + # Child process, execs command. + + close($read_fh); + + # TODO: 'no warnings exec' doesn't get rid + # of the 'unlikely to be reached' warnings. + # This is a bug in perl / perldiag / perllexwarn / warnings. + + no warnings; ## no critic + + CORE::exec { $command } $command, @args; + + # Oh no, exec fails! Send the reason why to + # the parent. + + print {$write_fh} int($!); + exit(-1); + } + + { + # In parent process. + + close($write_fh); + + # Parent process, check for child error. + my $error = <$read_fh>; + + # Tidy up our pipes. + close($read_fh); + + # Check for error. + if ($error) { + # Setting $! to our child error number gives + # us nice looking strings when printed. + local $! = $error; + croak sprintf(FAIL_START, $command, $!); + } + } + + # Parent process, we don't care about our pid, but we + # do go and read our pipe. + + if ($wantarray) { + my @results = <$pipe>; + close($pipe); + _process_child_error($?,$command,$valid_returns); + return @results; + } + + # NB: We don't check the return status on close(), since + # on failure it sets $?, which we then inspect for more + # useful information. + + my $results = join("",<$pipe>); + close($pipe); + _process_child_error($?,$command,$valid_returns); + + return $results; + +} + +# Tries really hard to spawn a process under Windows. Returns +# the pid on success, or undef on error. + +sub _spawn_or_die { + + # We need to wrap practically the entire sub in an + # if block to ensure it doesn't get compiled under non-Win32 + # systems. Compiling on these systems would not only be a + # waste of time, but also results in complaints about + # the NORMAL_PRIORITY_CLASS constant. + + if (not WINDOWS) { + croak sprintf(FAIL_INTERNAL, "_spawn_or_die called when not under Win32"); + } else { + my ($orig_exe, $cmdline) = @_; + my $pid; + + my $exe = $orig_exe; + + # If our command doesn't have an extension, add one. + $exe .= $Config{_exe} if ($exe !~ m{\.}); + + Win32::Process::Create( + $pid, $exe, $cmdline, 1, NORMAL_PRIORITY_CLASS, "." + ) and return $pid; + + my @path = split(/;/,$ENV{PATH}); + + foreach my $dir (@path) { + my $fullpath = File::Spec->catfile($dir,$exe); + + # We're using -x here on the assumption that stat() + # is faster than spawn, so trying to spawn a process + # for each path element will be unacceptably + # inefficient. + + if (-x $fullpath) { + Win32::Process::Create( + $pid, $fullpath, $cmdline, 1, + NORMAL_PRIORITY_CLASS, "." + ) and return $pid; + } + } + + croak sprintf(FAIL_START, $orig_exe, $^E); + } +} + +# Complain on tainted arguments or environment. +# ASSUME_TAINTED is true for 5.6.x, since it's missing ${^TAINT} + +sub _check_taint { + return if not (ASSUME_TAINTED or ${^TAINT}); + my $caller = (caller(1))[3]; + foreach my $var (@_) { + if (tainted $var) { + croak sprintf(FAIL_TAINT, $caller, $var); + } + } + foreach my $var (@Check_tainted_env) { + if (tainted $ENV{$var} ) { + croak sprintf(FAIL_TAINT_ENV, $caller, $var); + } + } + + return; + +} + +# This subroutine performs the difficult task of interpreting +# $?. It's not intended to be called directly, as it will +# croak on errors, and its implementation and interface may +# change in the future. + +sub _process_child_error { + my ($child_error, $command, $valid_returns) = @_; + + $EXITVAL = -1; + + my $coredump = WCOREDUMP($child_error); + + # There's a bug in perl 5.8.9 and 5.10.0 where if the system + # does not provide a native WCOREDUMP, then $? will + # never contain coredump information. This code + # checks to see if we have the bug, and works around + # it if needed. + + if ($] >= 5.008009 and not $NATIVE_WCOREDUMP) { + $coredump ||= WCOREDUMP( ${^CHILD_ERROR_NATIVE} ); + } + + if ($child_error == -1) { + croak sprintf(FAIL_START, $command, $!); + + } elsif ( WIFEXITED( $child_error ) ) { + $EXITVAL = WEXITSTATUS( $child_error ); + + return _check_exit($command,$EXITVAL,$valid_returns); + + } elsif ( WIFSIGNALED( $child_error ) ) { + my $signal_no = WTERMSIG( $child_error ); + my $signal_name = $Signal_from_number[$signal_no] || "UNKNOWN"; + + croak sprintf FAIL_SIGNAL, $command, $signal_name, $signal_no, ($coredump ? " and dumped core" : ""); + + + } + + croak sprintf(FAIL_INTERNAL, qq{'$command' ran without exit value or signal}); + +} + +# A simple subroutine for checking exit values. Results in better +# assurance of consistent error messages, and better forward support +# for new features in I::S::S. + +sub _check_exit { + my ($command, $exitval, $valid_returns) = @_; + + # If we have a single-value list consisting of the EXIT_ANY + # value, then we're happy with whatever exit value we're given. + if (@$valid_returns == 1 and $valid_returns->[0] == EXIT_ANY_CONST) { + return $exitval; + } + + if (not defined first { $_ == $exitval } @$valid_returns) { + croak sprintf FAIL_BADEXIT, $command, $exitval; + } + return $exitval; +} + + +# This subroutine simply determines a list of valid returns, the command +# name, and any arguments that we need to pass to it. + +sub _process_args { + my $valid_returns = [ 0 ]; + my $caller = (caller(1))[3]; + + if (not @_) { + croak "$caller called with no arguments"; + } + + if (ref $_[0] eq "ARRAY") { + $valid_returns = shift(@_); + } + + if (not @_) { + croak "$caller called with no command"; + } + + my $command = shift(@_); + + if (not defined $command) { + croak sprintf( FAIL_UNDEF, $caller ); + } + + return ($valid_returns,$command,@_); + +} + +1; + +__END__ + +=head1 NAME + +IPC::System::Simple - Run commands simply, with detailed diagnostics + +=head1 SYNOPSIS + + use IPC::System::Simple qw(system systemx capture capturex); + + system("some_command"); # Command succeeds or dies! + + system("some_command",@args); # Succeeds or dies, avoids shell if @args + + systemx("some_command",@args); # Succeeds or dies, NEVER uses the shell + + + # Capture the output of a command (just like backticks). Dies on error. + my $output = capture("some_command"); + + # Just like backticks in list context. Dies on error. + my @output = capture("some_command"); + + # As above, but avoids the shell if @args is non-empty + my $output = capture("some_command", @args); + + # As above, but NEVER invokes the shell. + my $output = capturex("some_command", @args); + my @output = capturex("some_command", @args); + +=head1 DESCRIPTION + +Calling Perl's in-built C function is easy, +determining if it was successful is I. Let's face it, +C<$?> isn't the nicest variable in the world to play with, and +even if you I check it, producing a well-formatted error +string takes a lot of work. + +C takes the hard work out of calling +external commands. In fact, if you want to be really lazy, +you can just write: + + use IPC::System::Simple qw(system); + +and all of your C commands will either succeed (run to +completion and return a zero exit value), or die with rich diagnostic +messages. + +The C module also provides a simple replacement +to Perl's backticks operator. Simply write: + + use IPC::System::Simple qw(capture); + +and then use the L command just like you'd use backticks. +If there's an error, it will die with a detailed description of what +went wrong. Better still, you can even use C to run the +equivalent of backticks, but without the shell: + + use IPC::System::Simple qw(capturex); + + my $result = capturex($command, @args); + +If you want more power than the basic interface, including the +ability to specify which exit values are acceptable, trap errors, +or process diagnostics, then read on! + +=head1 ADVANCED SYNOPSIS + + use IPC::System::Simple qw( + capture capturex system systemx run runx $EXITVAL EXIT_ANY + ); + + # Run a command, throwing exception on failure + + run("some_command"); + + runx("some_command",@args); # Run a command, avoiding the shell + + # Do the same thing, but with the drop-in system replacement. + + system("some_command"); + + systemx("some_command", @args); + + # Run a command which must return 0..5, avoid the shell, and get the + # exit value (we could also look at $EXITVAL) + + my $exit_value = runx([0..5], "some_command", @args); + + # The same, but any exit value will do. + + my $exit_value = runx(EXIT_ANY, "some_command", @args); + + # Capture output into $result and throw exception on failure + + my $result = capture("some_command"); + + # Check exit value from captured command + + print "some_command exited with status $EXITVAL\n"; + + # Captures into @lines, splitting on $/ + my @lines = capture("some_command"); + + # Run a command which must return 0..5, capture the output into + # @lines, and avoid the shell. + + my @lines = capturex([0..5], "some_command", @args); + +=head1 ADVANCED USAGE + +=head2 run() and system() + +C provides a subroutine called +C, that executes a command using the same semantics as +Perl's built-in C: + + use IPC::System::Simple qw(run); + + run("cat *.txt"); # Execute command via the shell + run("cat","/etc/motd"); # Execute command without shell + +The primary difference between Perl's in-built system and +the C command is that C will throw an exception on +failure, and allows a list of acceptable exit values to be set. +See L for further information. + +In fact, you can even have C replace the +default C function for your package so it has the +same behaviour: + + use IPC::System::Simple qw(system); + + system("cat *.txt"); # system now succeeds or dies! + +C and C are aliases to each other. + +See also L for variants of +C and C that never invoke the shell, even with +a single argument. + +=head2 capture() + +A second subroutine, named C executes a command with +the same semantics as Perl's built-in backticks (and C): + + use IPC::System::Simple qw(capture); + + # Capture text while invoking the shell. + my $file = capture("cat /etc/motd"); + my @lines = capture("cat /etc/passwd"); + +However unlike regular backticks, which always use the shell, C +will bypass the shell when called with multiple arguments: + + # Capture text while avoiding the shell. + my $file = capture("cat", "/etc/motd"); + my @lines = capture("cat", "/etc/passwd"); + +See also L for a variant of +C that never invokes the shell, even with a single +argument. + +=head2 runx(), systemx() and capturex() + +The C, C and C commands are identical +to the multi-argument forms of C, C and C +respectively, but I invoke the shell, even when called with a +single argument. These forms are particularly useful when a command's +argument list I be empty, for example: + + systemx($cmd, @args); + +The use of C here guarantees that the shell will I +be invoked, even if C<@args> is empty. + +=head2 Exception handling + +In the case where the command returns an unexpected status, both C and +C will throw an exception, which if not caught will terminate your +program with an error. + +Capturing the exception is easy: + + eval { + run("cat *.txt"); + }; + + if ($@) { + print "Something went wrong - $@\n"; + } + +See the diagnostics section below for more details. + +=head3 Exception cases + +C considers the following to be unexpected, +and worthy of exception: + +=over 4 + +=item * + +Failing to start entirely (eg, command not found, permission denied). + +=item * + +Returning an exit value other than zero (but see below). + +=item * + +Being killed by a signal. + +=item * + +Being passed tainted data (in taint mode). + +=back + +=head2 Exit values + +Traditionally, system commands return a zero status for success and a +non-zero status for failure. C will default to throwing +an exception if a non-zero exit value is returned. + +You may specify a range of values which are considered acceptable exit +values by passing an I as the first argument. The +special constant C can be used to allow I exit value +to be returned. + + use IPC::System::Simple qw(run system capture EXIT_ANY); + + run( [0..5], "cat *.txt"); # Exit values 0-5 are OK + + system( [0..5], "cat *.txt"); # This works the same way + + my @lines = capture( EXIT_ANY, "cat *.txt"); # Any exit is fine. + +The C and replacement C subroutines returns the exit +value of the process: + + my $exit_value = run( [0..5], "cat *.txt"); + + # OR: + + my $exit_value = system( [0..5] "cat *.txt"); + + print "Program exited with value $exit_value\n"; + +=head3 $EXITVAL + +The exit value of any command executed by C +can always be retrieved from the C<$IPC::System::Simple::EXITVAL> +variable: + +This is particularly useful when inspecting results from C, +which returns the captured text from the command. + + use IPC::System::Simple qw(capture $EXITVAL EXIT_ANY); + + my @enemies_defeated = capture(EXIT_ANY, "defeat_evil", "/dev/mordor"); + + print "Program exited with value $EXITVAL\n"; + +C<$EXITVAL> will be set to C<-1> if the command did not exit normally (eg, +being terminated by a signal) or did not start. In this situation an +exception will also be thrown. + +=head2 WINDOWS-SPECIFIC NOTES + +The C subroutine make available the full 32-bit exit value on +Win32 systems. This has been true since C v0.06 +when called with multiple arguments, and since v1.25 when called with +a single argument. This is different from the previous versions of +C and from Perl's in-build C function, +which can only handle 8-bit return values. + +The C subroutine always returns the 32-bit exit value under +Windows. The C subroutine also never uses the shell, +even when passed a single argument. + +The C subroutine always uses a shell when passed a single +argument. On NT systems, it uses C in the system root, and on +non-NT systems it uses C in the system root. + +As of C v1.25, the C and C +subroutines, as well as multiple-argument calls to the C and +C subroutines, have their arguments properly quoted, so that +arugments with spaces and the like work properly. Unfortunately, this +breaks any attempt to invoke the shell itself. If you really need to +execute C or C, use the single-argument form. +For single-argument calls to C and C, the argument must +be properly shell-quoted in advance of the call. + +Versions of C before v0.09 would not search +the C environment variable when the multi-argument form of +C was called. Versions from v0.09 onwards correctly search +the path provided the command is provided including the extension +(eg, C rather than just C, or C rather +than just C). If no extension is provided, C<.exe> is +assumed. + +Signals are not supported on Windows systems. Sending a signal +to a Windows process will usually cause it to exit with the signal +number used. + +=head1 DIAGNOSTICS + +=over 4 + +=item "%s" failed to start: "%s" + +The command specified did not even start. It may not exist, or +you may not have permission to use it. The reason it could not +start (as determined from C<$!>) will be provided. + +=item "%s" unexpectedly returned exit value %d + +The command ran successfully, but returned an exit value we did +not expect. The value returned is reported. + +=item "%s" died to signal "%s" (%d) %s + +The command was killed by a signal. The name of the signal +will be reported, or C if it cannot be determined. The +signal number is always reported. If we detected that the +process dumped core, then the string C is +appended. + +=item IPC::System::Simple::%s called with no arguments + +You attempted to call C or C but did not provide any +arguments at all. At the very lease you need to supply a command +to run. + +=item IPC::System::Simple::%s called with no command + +You called C or C with a list of acceptable exit values, +but no actual command. + +=item IPC::System::Simple::%s called with tainted argument "%s" + +You called C or C with tainted (untrusted) arguments, which is +almost certainly a bad idea. To untaint your arguments you'll need to pass +your data through a regular expression and use the resulting match variables. +See L for more information. + +=item IPC::System::Simple::%s called with tainted environment $ENV{%s} + +You called C or C but part of your environment was tainted +(untrusted). You should either delete the named environment +variable before calling C, or set it to an untainted value +(usually one set inside your program). See +L for more information. + +=item Error in IPC::System::Simple plumbing: "%s" - "%s" + +Implementing the C command involves dark and terrible magicks +involving pipes, and one of them has sprung a leak. This could be due to a +lack of file descriptors, although there are other possibilities. + +If you are able to reproduce this error, you are encouraged +to submit a bug report according to the L section below. + +=item Internal error in IPC::System::Simple: "%s" + +You've found a bug in C. Please check to +see if an updated version of C is available. +If not, please file a bug report according to the L section +below. + +=item IPC::System::Simple::%s called with undefined command + +You've passed the undefined value as a command to be executed. +While this is a very Zen-like action, it's not supported by +Perl's current implementation. + +=back + +=head1 DEPENDENCIES + +This module depends upon L when used on Win32 +system. C is bundled as a core module in ActivePerl 5.6 +and above. + +There are no non-core dependencies on non-Win32 systems. + +=head1 COMPARISON TO OTHER APIs + +Perl provides a range of in-built functions for handling external +commands, and CPAN provides even more. The C +differentiates itself from other options by providing: + +=over 4 + +=item Extremely detailed diagnostics + +The diagnostics produced by C are designed +to provide as much information as possible. Rather than requiring +the developer to inspect C<$?>, C does the +hard work for you. + +If an odd exit status is provided, you're informed of what it is. If a +signal kills your process, you are informed of both its name and number. +If tainted data or environment prevents your command from running, you +are informed of exactly which data or environmental variable is +tainted. + +=item Exceptions on failure + +C takes an aggressive approach to error handling. +Rather than allow commands to fail silently, exceptions are thrown +when unexpected results are seen. This allows for easy development +using a try/catch style, and avoids the possibility of accidentally +continuing after a failed command. + +=item Easy access to exit status + +The C, C and C commands all set C<$EXITVAL>, +making it easy to determine the exit status of a command. +Additionally, the C and C interfaces return the exit +status. + +=item Consistent interfaces + +When called with multiple arguments, the C, C and +C interfaces I invoke the shell. This differs +from the in-built Perl C command which may invoke the +shell under Windows when called with multiple arguments. It +differs from the in-built Perl backticks operator which always +invokes the shell. + +=back + +=head1 BUGS + +When C is exported, the exotic form C +is not supported. Attemping to use the exotic form is a syntax +error. This affects the calling package I. Use C +if you need it, or consider using the L module to replace +C with lexical scope. + +Core dumps are only checked for when a process dies due to a +signal. It is not believed there are any systems where processes +can dump core without dying to a signal. + +C status is not checked, as perl never spawns processes +with the C option. + +Signals are not supported under Win32 systems, since they don't +work at all like Unix signals. Win32 signals cause commands to +exit with a given exit value, which this modules I capture. + +=head2 Reporting bugs + +Before reporting a bug, please check to ensure you are using the +most recent version of C. Your problem may +have already been fixed in a new release. + +You can find the C bug-tracker at +L . +Please check to see if your bug has already been reported; if +in doubt, report yours anyway. + +Submitting a patch and/or failing test case will greatly expedite +the fixing of bugs. + +=head1 FEEDBACK + +If you find this module useful, please consider rating it on the +CPAN Ratings service at +L . + +The module author loves to hear how C has made +your life better (or worse). Feedback can be sent to +Epjf@perltraining.com.auE. + +=head1 SEE ALSO + +L uses C to provide succeed-or-die +replacements to C (and other built-ins) with lexical scope. + +L, L, L, L, L, +L, L + +=head1 AUTHOR + +Paul Fenwick Epjf@cpan.orgE + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2006-2008 by Paul Fenwick + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself, either Perl version 5.6.0 or, +at your option, any later version of Perl 5 you may have available. + +=for Pod::Coverage WCOREDUMP + +=cut diff --git a/tests/lib/Path/Tiny.pm b/tests/lib/Path/Tiny.pm new file mode 100644 index 0000000..b8c6804 --- /dev/null +++ b/tests/lib/Path/Tiny.pm @@ -0,0 +1,3880 @@ +use 5.008001; +use strict; +use warnings; + +package Path::Tiny; +# ABSTRACT: File path utility + +our $VERSION = '0.144'; + +# Dependencies +use Config; +use Exporter 5.57 (qw/import/); +use File::Spec 0.86 (); # shipped with 5.8.1 +use Carp (); + +our @EXPORT = qw/path/; +our @EXPORT_OK = qw/cwd rootdir tempfile tempdir/; + +use constant { + PATH => 0, + CANON => 1, + VOL => 2, + DIR => 3, + FILE => 4, + TEMP => 5, + IS_WIN32 => ( $^O eq 'MSWin32' ), +}; + +use overload ( + q{""} => 'stringify', + bool => sub () { 1 }, + fallback => 1, +); + +# FREEZE/THAW per Sereal/CBOR/Types::Serialiser protocol +sub THAW { return path( $_[2] ) } +{ no warnings 'once'; *TO_JSON = *FREEZE = \&stringify }; + +my $HAS_UU; # has Unicode::UTF8; lazily populated + +sub _check_UU { + local $SIG{__DIE__}; # prevent outer handler from being called + !!eval { + require Unicode::UTF8; + Unicode::UTF8->VERSION(0.58); + 1; + }; +} + +my $HAS_PU; # has PerlIO::utf8_strict; lazily populated + +sub _check_PU { + local $SIG{__DIE__}; # prevent outer handler from being called + !!eval { + # MUST preload Encode or $SIG{__DIE__} localization fails + # on some Perl 5.8.8 (maybe other 5.8.*) compiled with -O2. + require Encode; + require PerlIO::utf8_strict; + PerlIO::utf8_strict->VERSION(0.003); + 1; + }; +} + +my $HAS_FLOCK = $Config{d_flock} || $Config{d_fcntl_can_lock} || $Config{d_lockf}; + +# notions of "root" directories differ on Win32: \\server\dir\ or C:\ or \ +my $SLASH = qr{[\\/]}; +my $NOTSLASH = qr{[^\\/]}; +my $DRV_VOL = qr{[a-z]:}i; +my $UNC_VOL = qr{$SLASH $SLASH $NOTSLASH+ $SLASH $NOTSLASH+}x; +my $WIN32_ROOT = qr{(?: $UNC_VOL $SLASH | $DRV_VOL $SLASH | $SLASH )}x; + +sub _win32_vol { + my ( $path, $drv ) = @_; + require Cwd; + my $dcwd = eval { Cwd::getdcwd($drv) }; # C: -> C:\some\cwd + # getdcwd on non-existent drive returns empty string + # so just use the original drive Z: -> Z: + $dcwd = "$drv" unless defined $dcwd && length $dcwd; + # normalize dwcd to end with a slash: might be C:\some\cwd or D:\ or Z: + $dcwd =~ s{$SLASH?\z}{/}; + # make the path absolute with dcwd + $path =~ s{^$DRV_VOL}{$dcwd}; + return $path; +} + +# This is a string test for before we have the object; see is_rootdir for well-formed +# object test +sub _is_root { + return IS_WIN32() ? ( $_[0] =~ /^$WIN32_ROOT\z/ ) : ( $_[0] eq '/' ); +} + +BEGIN { + *_same = IS_WIN32() ? sub { lc( $_[0] ) eq lc( $_[1] ) } : sub { $_[0] eq $_[1] }; +} + +# mode bits encoded for chmod in symbolic mode +my %MODEBITS = ( om => 0007, gm => 0070, um => 0700 ); ## no critic +{ my $m = 0; $MODEBITS{$_} = ( 1 << $m++ ) for qw/ox ow or gx gw gr ux uw ur/ }; + +sub _symbolic_chmod { + my ( $mode, $symbolic ) = @_; + for my $clause ( split /,\s*/, $symbolic ) { + if ( $clause =~ m{\A([augo]+)([=+-])([rwx]+)\z} ) { + my ( $who, $action, $perms ) = ( $1, $2, $3 ); + $who =~ s/a/ugo/g; + for my $w ( split //, $who ) { + my $p = 0; + $p |= $MODEBITS{"$w$_"} for split //, $perms; + if ( $action eq '=' ) { + $mode = ( $mode & ~$MODEBITS{"${w}m"} ) | $p; + } + else { + $mode = $action eq "+" ? ( $mode | $p ) : ( $mode & ~$p ); + } + } + } + else { + Carp::croak("Invalid mode clause '$clause' for chmod()"); + } + } + return $mode; +} + +# flock doesn't work on NFS on BSD or on some filesystems like lustre. +# Since program authors often can't control or detect that, we warn once +# instead of being fatal if we can detect it and people who need it strict +# can fatalize the 'flock' category + +#<<< No perltidy +{ package flock; use warnings::register } +#>>> + +my $WARNED_NO_FLOCK = 0; + +sub _throw { + my ( $self, $function, $file, $msg ) = @_; + if ( $function =~ /^flock/ + && $! =~ /operation not supported|function not implemented/i + && !warnings::fatal_enabled('flock') ) + { + if ( !$WARNED_NO_FLOCK ) { + warnings::warn( flock => "Flock not available: '$!': continuing in unsafe mode" ); + $WARNED_NO_FLOCK++; + } + } + else { + $msg = $! unless defined $msg; + Path::Tiny::Error->throw( $function, ( defined $file ? $file : $self->[PATH] ), + $msg ); + } + return; +} + +# cheapo option validation +sub _get_args { + my ( $raw, @valid ) = @_; + if ( defined($raw) && ref($raw) ne 'HASH' ) { + my ( undef, undef, undef, $called_as ) = caller(1); + $called_as =~ s{^.*::}{}; + Carp::croak("Options for $called_as must be a hash reference"); + } + my $cooked = {}; + for my $k (@valid) { + $cooked->{$k} = delete $raw->{$k} if exists $raw->{$k}; + } + if ( keys %$raw ) { + my ( undef, undef, undef, $called_as ) = caller(1); + $called_as =~ s{^.*::}{}; + Carp::croak( "Invalid option(s) for $called_as: " . join( ", ", keys %$raw ) ); + } + return $cooked; +} + +#--------------------------------------------------------------------------# +# Constructors +#--------------------------------------------------------------------------# + +#pod =construct path +#pod +#pod $path = path("foo/bar"); +#pod $path = path("/tmp", "file.txt"); # list +#pod $path = path("."); # cwd +#pod +#pod Constructs a C object. It doesn't matter if you give a file or +#pod directory path. It's still up to you to call directory-like methods only on +#pod directories and file-like methods only on files. This function is exported +#pod automatically by default. +#pod +#pod The first argument must be defined and have non-zero length or an exception +#pod will be thrown. This prevents subtle, dangerous errors with code like +#pod C<< path( maybe_undef() )->remove_tree >>. +#pod +#pod B: If and only if the B character of the B argument +#pod to C is a tilde ('~'), then tilde replacement will be applied to the +#pod first path segment. A single tilde will be replaced with C and a +#pod tilde followed by a username will be replaced with output of +#pod C. B. +#pod See L for more. +#pod +#pod On Windows, if the path consists of a drive identifier without a path component +#pod (C or C), it will be expanded to the absolute path of the current +#pod directory on that volume using C. +#pod +#pod If called with a single C argument, the original is returned unless +#pod the original is holding a temporary file or directory reference in which case a +#pod stringified copy is made. +#pod +#pod $path = path("foo/bar"); +#pod $temp = Path::Tiny->tempfile; +#pod +#pod $p2 = path($path); # like $p2 = $path +#pod $t2 = path($temp); # like $t2 = path( "$temp" ) +#pod +#pod This optimizes copies without proliferating references unexpectedly if a copy is +#pod made by code outside your control. +#pod +#pod Current API available since 0.017. +#pod +#pod =cut + +sub path { + my $path = shift; + Carp::croak("Path::Tiny paths require defined, positive-length parts") + unless 1 + @_ == grep { defined && length } $path, @_; + + # non-temp Path::Tiny objects are effectively immutable and can be reused + if ( !@_ && ref($path) eq __PACKAGE__ && !$path->[TEMP] ) { + return $path; + } + + # stringify objects + $path = "$path"; + + # do any tilde expansions + my ($tilde) = $path =~ m{^(~[^/]*)}; + if ( defined $tilde ) { + # Escape File::Glob metacharacters + (my $escaped = $tilde) =~ s/([\[\{\*\?\\])/\\$1/g; + require File::Glob; + my ($homedir) = File::Glob::bsd_glob($escaped); + if (defined $homedir && ! $File::Glob::ERROR) { + $homedir =~ tr[\\][/] if IS_WIN32(); + $path =~ s{^\Q$tilde\E}{$homedir}; + } + } + + unshift @_, $path; + goto &_pathify; +} + +# _path is like path but without tilde expansion +sub _path { + my $path = shift; + Carp::croak("Path::Tiny paths require defined, positive-length parts") + unless 1 + @_ == grep { defined && length } $path, @_; + + # non-temp Path::Tiny objects are effectively immutable and can be reused + if ( !@_ && ref($path) eq __PACKAGE__ && !$path->[TEMP] ) { + return $path; + } + + # stringify objects + $path = "$path"; + + unshift @_, $path; + goto &_pathify; +} + +# _pathify expects one or more string arguments, then joins and canonicalizes +# them into an object. +sub _pathify { + my $path = shift; + + # expand relative volume paths on windows; put trailing slash on UNC root + if ( IS_WIN32() ) { + $path = _win32_vol( $path, $1 ) if $path =~ m{^($DRV_VOL)(?:$NOTSLASH|\z)}; + $path .= "/" if $path =~ m{^$UNC_VOL\z}; + } + + # concatenations stringifies objects, too + if (@_) { + $path .= ( _is_root($path) ? "" : "/" ) . join( "/", @_ ); + } + + + # canonicalize, but with unix slashes and put back trailing volume slash + my $cpath = $path = File::Spec->canonpath($path); + $path =~ tr[\\][/] if IS_WIN32(); + $path = "/" if $path eq '/..'; # for old File::Spec + $path .= "/" if IS_WIN32() && $path =~ m{^$UNC_VOL\z}; + + # root paths must always have a trailing slash, but other paths must not + if ( _is_root($path) ) { + $path =~ s{/?\z}{/}; + } + else { + $path =~ s{/\z}{}; + } + + bless [ $path, $cpath ], __PACKAGE__; +} + +#pod =construct new +#pod +#pod $path = Path::Tiny->new("foo/bar"); +#pod +#pod This is just like C, but with method call overhead. (Why would you +#pod do that?) +#pod +#pod Current API available since 0.001. +#pod +#pod =cut + +sub new { shift; path(@_) } + +#pod =construct cwd +#pod +#pod $path = Path::Tiny->cwd; # path( Cwd::getcwd ) +#pod $path = cwd; # optional export +#pod +#pod Gives you the absolute path to the current directory as a C object. +#pod This is slightly faster than C<< path(".")->absolute >>. +#pod +#pod C may be exported on request and used as a function instead of as a +#pod method. +#pod +#pod Current API available since 0.018. +#pod +#pod =cut + +sub cwd { + require Cwd; + return _path( Cwd::getcwd() ); +} + +#pod =construct rootdir +#pod +#pod $path = Path::Tiny->rootdir; # / +#pod $path = rootdir; # optional export +#pod +#pod Gives you C<< File::Spec->rootdir >> as a C object if you're too +#pod picky for C. +#pod +#pod C may be exported on request and used as a function instead of as a +#pod method. +#pod +#pod Current API available since 0.018. +#pod +#pod =cut + +sub rootdir { _path( File::Spec->rootdir ) } + +#pod =construct tempfile, tempdir +#pod +#pod $temp = Path::Tiny->tempfile( @options ); +#pod $temp = Path::Tiny->tempdir( @options ); +#pod $temp = $dirpath->tempfile( @options ); +#pod $temp = $dirpath->tempdir( @options ); +#pod $temp = tempfile( @options ); # optional export +#pod $temp = tempdir( @options ); # optional export +#pod +#pod C passes the options to C<< File::Temp->new >> and returns a +#pod C object with the file name. The C option will be enabled +#pod by default, but you can override that by passing C<< TMPDIR => 0 >> along with +#pod the options. (If you use an absolute C