diff --git a/lib/Path/Tiny.pm b/lib/Path/Tiny.pm index b721f78..52ee15d 100644 --- a/lib/Path/Tiny.pm +++ b/lib/Path/Tiny.pm @@ -2415,6 +2415,46 @@ sub volume { return $self->[VOL]; } +=method change_extension + + my $foo = path('C:/mydir/myfile.com.extension'); + my $renamed_foo = $foo->change_extension('.old'); + +Changes the extension of a path. + +Returns a new Path::Tiny object with a different extension. The argument is a +string representing the new extension or undef to remove an extension. + +If path has no extension, and extension is not C, the returned path string contains extension appended to the end of path. +If the last part of a path has a leading period (e.g. C<~/.bashrc>), it is not considered an extension. + +Current API available since 0.148. + +=cut + +sub change_extension { + my $self = shift; + my $new_extension = shift; # may be undef + + my $path_str = $self->stringify; + $path_str =~ s/\.[^.\/]+$//; # Remove existing extension + + # If extension is undef, the returned string contains the specified path with its extension removed. + return path($path_str) unless defined $new_extension; + + if( $new_extension !~ m/^\./ ) { + # add leading period if there is no period + $new_extension = '.' . $new_extension; + } + + # Add extension and construct the new path + my $new_path = _path($path_str . $new_extension); + + return $new_path; +} + + + package Path::Tiny::Error; our @CARP_NOT = qw/Path::Tiny/; diff --git a/t/change_extension.t b/t/change_extension.t new file mode 100644 index 0000000..6b95a9c --- /dev/null +++ b/t/change_extension.t @@ -0,0 +1,67 @@ +use 5.008001; +use strict; +use warnings; +use Test::More 0.96; + +use lib 't/lib'; + +use Path::Tiny; + +my @cases = ( + # path1 => path2 => path1->subsumes(path2) + + "rename path with extension" => [ + [ '.', '.ext', '.ext' ], + [ '/', '.ext', '/.ext' ], + [ '..', '.ext', '..ext' ], + [ '../..', '.ext', '../..ext' ], + [ '/foo/', '.ext', '/foo.ext' ], # differs from C#: /foo/.ext + [ '/foo', '.ext', '/foo.ext' ], + [ 'foo/', '.ext', 'foo.ext' ], # differs from C#: foo/.ext + [ './foo', '.ext', 'foo.ext' ], # differs from C#: ./foo.ext + [ 'foo/.', '.ext', 'foo.ext' ], # differs from C#: foo/.ext + [ 'C:/temp/myfile.com.extension', '.old', 'C:/temp/myfile.com.old' ], + [ 'C:/temp/myfile.com.extension', 'old', 'C:/temp/myfile.com.old' ], + [ 'C:/pathwithoutextension', '.old', 'C:/pathwithoutextension.old' ], + [ 'C:/pathwithoutextension', 'old', 'C:/pathwithoutextension.old' ], + # ~ paths + ], + + "remove extension" => [ + [ '.', undef, '' ], + [ '/', undef, '/' ], + [ '..', undef, '.' ], + [ '../..', undef, '../.' ], + [ '/foo/', undef, '/foo' ], # differs from C#: /foo/ + [ '/foo', undef, '/foo' ], + [ 'foo/', undef, 'foo' ], # differs from C#: foo/ + [ './foo', undef, 'foo' ], # differs from C#: ./foo + [ 'foo/.', undef, 'foo' ], # differs from C#: foo/ + [ 'C:/temp/myfile.com.extension', undef, 'C:/temp/myfile.com' ], + [ 'C:/temp/myfile.com.extension', undef, 'C:/temp/myfile.com' ], + [ 'C:/pathwithoutextension', undef, 'C:/pathwithoutextension' ], + [ 'C:/pathwithoutextension', undef, 'C:/pathwithoutextension' ], + ], + +); + + + +while (@cases) { + my ( $subtest, $tests ) = splice( @cases, 0, 2 ); + + subtest $subtest => sub { + for my $t (@$tests) { + my ( $path1, $ext, $path2 ) = @$t; + my $label = sprintf("%s + %s -> %s", $path1, (defined $ext ? $ext : 'undef'), $path2); + my $changed_path = path($path1)->change_extension($ext); + ok( $changed_path->stringify eq $path2, $label ) + or diag "PATH 1:\n", explain( path($path1) ), "\nCHANGED PATH:\n", explain( $changed_path ), "\nPATH2:\n", + explain( path($path2) ); + } + }; +} + +ok(1); + +done_testing;