File Coverage

blib/lib/Toader/findToaderRoot.pm
Criterion Covered Total %
statement 15 60 25.0
branch 0 16 0.0
condition n/a
subroutine 5 7 71.4
pod 2 2 100.0
total 22 85 25.8


line stmt bran cond sub pod time code
1             package Toader::findToaderRoot;
2              
3 17     17   21892 use warnings;
  17         32  
  17         471  
4 17     17   85 use strict;
  17         43  
  17         333  
5 17     17   548 use Toader::isaToaderDir;
  17         29  
  17         368  
6 17     17   85 use Cwd 'abs_path';
  17         25  
  17         948  
7 17     17   78 use base 'Error::Helper';
  17         31  
  17         8290  
8              
9             =head1 NAME
10              
11             Toader::findToaderRoot - This finds the root Toader directory.
12              
13             =head1 VERSION
14              
15             Version 0.1.0
16              
17             =cut
18              
19             our $VERSION = '0.1.0';
20              
21             =head1 SYNOPSIS
22              
23             use Toader::findToaderRoot;
24              
25             my $foo = Toader::findToaderRoot->new();
26              
27             my $root=$foo->findToaderRoot($directory);
28             if($foo->error){
29             warn('Error '.$foo->error.': '.$foo->errorString);
30             }else{
31             print $root."\n";
32             }
33              
34             =head1 METHODS
35              
36             =head2 new
37              
38             This initiates the object.
39              
40             my $foo = Toader::findToaderRoot->new();
41              
42             =cut
43              
44             sub new{
45 0     0 1   my $self={
46             error=>undef,
47             errorString=>'',
48             perror=>undef,
49             errorExtra=>{
50             flags=>{
51             1=>'noDirSpecified',
52             2=>'notAdir',
53             3=>'notAtoaderDir',
54             4=>'isaToaderDirErrored',
55             5=>'rootIsAtoaderDir',
56             },
57             },
58             };
59 0           bless $self;
60              
61 0           return $self;
62             }
63              
64             =head2 findToaderRoot
65              
66             This takes a directory and then finds the root for that Toader repo.
67              
68             One argument is required and it is the directory to start in.
69              
70             One value is returned and it is the root directory.
71              
72             my $root=$foo->findToaderRoot($directory);
73             if($foo->error){
74             warn('Error '.$foo->error.': '.$foo->errorString);
75             }else{
76             print $root."\n";
77             }
78              
79             =cut
80              
81             sub findToaderRoot{
82 0     0 1   my $self=$_[0];
83 0           my $dir=$_[1];
84              
85             #blank any previous errors
86 0 0         if(!$self->errorblank){
87 0           return undef;
88             }
89              
90             # Makes sure a directory is specified.
91 0 0         if (!defined( $dir )) {
92 0           $self->{error}=1;
93 0           $self->{errorString}='No directory defined';
94 0           $self->warn;
95 0           return undef;
96             }
97              
98             # Make sure the what is a directory.
99 0 0         if (! -d $dir ) {
100 0           $self->{error}=2;
101 0           $self->{errorString}='The specified item is not a directory';
102 0           $self->warn;
103 0           return undef;
104             }
105              
106             #initiates the directory checker
107 0           my $isatd=Toader::isaToaderDir->new;
108              
109             #make sure the directory we were passed is a Toader directory
110 0           my $returned=$isatd->isaToaderDir($dir);
111 0 0         if ($isatd->error) {
112 0           $self->{error}=4;
113 0           $self->{errorString}='isaToaderDir returned "'.$isatd->error.
114             '", "'.$isatd->errorString.'"';
115 0           $self->warn;
116 0           return undef;
117             }
118 0 0         if (!$returned) {
119 0           $self->{error}=3;
120 0           $self->{errorString}='"'.$dir.'" is not a Toader directory';
121 0           $self->warn;
122 0           return undef;
123             }
124              
125             #makes sure we don't have /
126             #There is no good reason we should ever have / as a toader directory...
127             #It means some idiot really fucked something up.
128 0 0         if ($dir eq '/') {
129 0           $self->{error}=5;
130 0           $self->{errorString}='"/" is the directory and it appears to be a Toader directory';
131 0           $self->warn;
132 0           return undef;
133             }
134              
135             #this stores the previous directory
136 0           my $pdir=$dir;
137              
138 0           $dir=abs_path($dir.'/..');
139             #we will always find something below so it is just set to 1
140 0           while (1) {
141             #we hit the FS root...
142 0 0         if ($dir eq '/') {
143 0           return $pdir;
144             }
145              
146 0           $returned=$isatd->isaToaderDir($dir);
147             #If we got this far, it means, there is no point in
148             #checking here again.
149 0 0         if (!$returned) {
150 0           return $pdir
151             }
152              
153 0           $pdir=$dir;
154 0           $dir=abs_path($dir.'/..');
155             }
156              
157             #we should never get here
158 0           return undef;
159             }
160              
161             =head1 ERROR CODES
162              
163             =head2 1, noDirSpecified
164              
165             No directory specified.
166              
167             =head2 2, notAdir
168              
169             Not a directory.
170              
171             =head2 3, notAtoaderDir
172              
173             Not a Toader directory.
174              
175             =head2 4, isaToaderDirErrored
176              
177             L->isaToaderDir errored.
178              
179             =head2 5, rootIsAtoaderDir
180              
181             "/" is the directory and it appears to be a Toader directory.
182              
183             This is a major WTF and should not be even if '/.toader' exists.
184              
185             =head1 AUTHOR
186              
187             Zane C. Bowers-Hadley, C<< >>
188              
189             =head1 BUGS
190              
191             Please report any bugs or feature requests to C, or through
192             the web interface at L. I will be notified, and then you'll
193             automatically be notified of progress on your bug as I make changes.
194              
195              
196              
197              
198             =head1 SUPPORT
199              
200             You can find documentation for this module with the perldoc command.
201              
202             perldoc Toader::findToaderRoot
203              
204              
205             You can also look for information at:
206              
207             =over 4
208              
209             =item * RT: CPAN's request tracker
210              
211             L
212              
213             =item * AnnoCPAN: Annotated CPAN documentation
214              
215             L
216              
217             =item * CPAN Ratings
218              
219             L
220              
221             =item * Search CPAN
222              
223             L
224              
225             =back
226              
227              
228             =head1 ACKNOWLEDGEMENTS
229              
230              
231             =head1 LICENSE AND COPYRIGHT
232              
233             Copyright 2013 Zane C. Bowers-Hadley.
234              
235             This program is free software; you can redistribute it and/or modify it
236             under the terms of either: the GNU General Public License as published
237             by the Free Software Foundation; or the Artistic License.
238              
239             See http://dev.perl.org/licenses/ for more information.
240              
241              
242             =cut
243              
244             1; # End of Toader::findToaderRoot