X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FApp%2FRgit%2FUtils.pm;h=c081d9b99cb5ed4453abbaac78eea9b3241a7330;hb=2e8121b94bf4847686087060a709fa3bb433f4ee;hp=2d593cce1cab80b8fc55fe6c98a6f65bcda7b857;hpb=3c8ced43d1e1f8fb7e136aa6f39237c91f6bf8f9;p=perl%2Fmodules%2Frgit.git diff --git a/lib/App/Rgit/Utils.pm b/lib/App/Rgit/Utils.pm index 2d593cc..c081d9b 100644 --- a/lib/App/Rgit/Utils.pm +++ b/lib/App/Rgit/Utils.pm @@ -3,7 +3,8 @@ package App::Rgit::Utils; use strict; use warnings; -use Carp qw/croak/; +use Cwd (); # abs_path +use File::Spec (); # file_name_is_absolute, updir, splitdir, splitpath =head1 NAME @@ -11,11 +12,11 @@ App::Rgit::Utils - Miscellaneous utilities for App::Rgit classes. =head1 VERSION -Version 0.06 +Version 0.08 =cut -our $VERSION = '0.06'; +our $VERSION = '0.08'; =head1 DESCRIPTION @@ -23,6 +24,29 @@ Miscellaneous utilities for L classes. This is an internal module to L. +=head1 FUNCTIONS + +=head2 C + +Forcefully make a path C<$path> absolute (in L's meaning of the term) when it isn't already absolute or when it contains C<'..'>. + +=cut + +sub abs_path { + my ($path) = @_; + + if (File::Spec->file_name_is_absolute($path)) { + my $updir = File::Spec->updir; + my @chunks = File::Spec->splitdir((File::Spec->splitpath($path))[1]); + + unless (grep $_ eq $updir, @chunks) { + return $path; + } + } + + return Cwd::abs_path($path); +} + =head1 CONSTANTS =head2 C, C, C, C @@ -51,25 +75,9 @@ use constant { CRIT => 0, }; -=head1 FUNCTIONS - -=head2 C - -Sanitize arguments passed to methods. - -=cut - -sub validate { - my $class = shift; - croak 'Optional arguments must be passed as key/value pairs' if @_ % 2; - $class = ref($class) || $class; - $class = caller unless $class; - return $class, @_; -} - =head1 EXPORT -C is only exported on request, either by its name or by the C<'funcs'> tag. +L is only exported on request. C C, C and C are only exported on request, either by their name or by the C<'codes'> tags. @@ -81,7 +89,7 @@ use base qw/Exporter/; our @EXPORT = (); our %EXPORT_TAGS = ( - funcs => [ qw/validate/ ], + funcs => [ qw/abs_path/ ], codes => [ qw/SAVE NEXT REDO LAST/ ], levels => [ qw/INFO WARN ERR CRIT/ ], ); @@ -95,12 +103,13 @@ L. =head1 AUTHOR Vincent Pit, C<< >>, L. - + You can contact me by mail or on C (vincent). =head1 BUGS -Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. +Please report any bugs or feature requests to C, or through the web interface at L. +I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT @@ -110,7 +119,7 @@ You can find documentation for this module with the perldoc command. =head1 COPYRIGHT & LICENSE -Copyright 2008-2009 Vincent Pit, all rights reserved. +Copyright 2008,2009,2010 Vincent Pit, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.