File Coverage

blib/lib/App/Rgit/Utils.pm
Criterion Covered Total %
statement 28 28 100.0
branch 3 4 75.0
condition n/a
subroutine 8 8 100.0
pod 1 1 100.0
total 40 41 97.5


line stmt bran cond sub pod time code
1             package App::Rgit::Utils;
2              
3 5     5   50722 use strict;
  5         9  
  5         163  
4 5     5   24 use warnings;
  5         10  
  5         111  
5              
6 5     5   24 use Cwd (); # abs_path
  5         10  
  5         62  
7 5     5   34 use File::Spec (); # file_name_is_absolute, updir, splitdir, splitpath
  5         23  
  5         883  
8              
9             =head1 NAME
10              
11             App::Rgit::Utils - Miscellaneous utilities for App::Rgit classes.
12              
13             =head1 VERSION
14              
15             Version 0.08
16              
17             =cut
18              
19             our $VERSION = '0.08';
20              
21             =head1 DESCRIPTION
22              
23             Miscellaneous utilities for L classes.
24              
25             This is an internal module to L.
26              
27             =head1 FUNCTIONS
28              
29             =head2 C
30              
31             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<'..'>.
32              
33             =cut
34              
35             sub abs_path {
36 110     110 1 208 my ($path) = @_;
37              
38 110 100       1541 if (File::Spec->file_name_is_absolute($path)) {
39 72         355 my $updir = File::Spec->updir;
40 72         1318 my @chunks = File::Spec->splitdir((File::Spec->splitpath($path))[1]);
41              
42 72 50       444 unless (grep $_ eq $updir, @chunks) {
43 72         326 return $path;
44             }
45             }
46              
47 38         2976 return Cwd::abs_path($path);
48             }
49              
50             =head1 CONSTANTS
51              
52             =head2 C, C, C, C
53              
54             Codes to return from the C callback to respectively proceed to the next repository, retry the current one, end it all, and save the return code.
55              
56             =cut
57              
58             use constant {
59 5         635 SAVE => 0x1,
60             NEXT => 0x2,
61             REDO => 0x4,
62             LAST => 0x8,
63 5     5   30 };
  5         6  
64              
65             =head2 C, C, C, C and C
66              
67             Message levels.
68              
69             =cut
70              
71             use constant {
72 5         396 INFO => 3,
73             WARN => 2,
74             ERR => 1,
75             CRIT => 0,
76 5     5   31 };
  5         10  
77              
78             =head1 EXPORT
79              
80             L is only exported on request.
81              
82             C C, C and C are only exported on request, either by their name or by the C<'codes'> tags.
83              
84             C, C, C and C are only exported on request, either by their name or by the C<'levels'> tags.
85              
86             =cut
87              
88 5     5   25 use base qw/Exporter/;
  5         10  
  5         1209  
89              
90             our @EXPORT = ();
91             our %EXPORT_TAGS = (
92             funcs => [ qw/abs_path/ ],
93             codes => [ qw/SAVE NEXT REDO LAST/ ],
94             levels => [ qw/INFO WARN ERR CRIT/ ],
95             );
96             our @EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
97             $EXPORT_TAGS{'all'} = [ @EXPORT_OK ];
98              
99             =head1 SEE ALSO
100              
101             L.
102              
103             =head1 AUTHOR
104              
105             Vincent Pit, C<< >>, L.
106              
107             You can contact me by mail or on C (vincent).
108              
109             =head1 BUGS
110              
111             Please report any bugs or feature requests to C, or through the web interface at L.
112             I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
113              
114             =head1 SUPPORT
115              
116             You can find documentation for this module with the perldoc command.
117              
118             perldoc App::Rgit::Utils
119              
120             =head1 COPYRIGHT & LICENSE
121              
122             Copyright 2008,2009,2010 Vincent Pit, all rights reserved.
123              
124             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
125              
126             =cut
127              
128             1; # End of App::Rgit::Utils