| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | =head1 NAME | 
| 2 |  |  |  |  |  |  |  | 
| 3 |  |  |  |  |  |  | Devel::PerlySense::Project - A Project root | 
| 4 |  |  |  |  |  |  |  | 
| 5 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 6 |  |  |  |  |  |  |  | 
| 7 |  |  |  |  |  |  |  | 
| 8 |  |  |  |  |  |  |  | 
| 9 |  |  |  |  |  |  |  | 
| 10 |  |  |  |  |  |  | =head1 DESCRIPTION | 
| 11 |  |  |  |  |  |  |  | 
| 12 |  |  |  |  |  |  | A Project describes the root directory of a source tree. | 
| 13 |  |  |  |  |  |  |  | 
| 14 |  |  |  |  |  |  | A Project has configuration settings. | 
| 15 |  |  |  |  |  |  |  | 
| 16 |  |  |  |  |  |  | =cut | 
| 17 |  |  |  |  |  |  |  | 
| 18 |  |  |  |  |  |  |  | 
| 19 |  |  |  |  |  |  |  | 
| 20 |  |  |  |  |  |  |  | 
| 21 |  |  |  |  |  |  |  | 
| 22 | 63 |  |  | 63 |  | 218 | use strict; | 
|  | 63 |  |  |  |  | 81 |  | 
|  | 63 |  |  |  |  | 1790 |  | 
| 23 | 63 |  |  | 63 |  | 229 | use warnings; | 
|  | 63 |  |  |  |  | 64 |  | 
|  | 63 |  |  |  |  | 1571 |  | 
| 24 | 63 |  |  | 63 |  | 1054 | use utf8; | 
|  | 63 |  |  |  |  | 110 |  | 
|  | 63 |  |  |  |  | 315 |  | 
| 25 |  |  |  |  |  |  |  | 
| 26 |  |  |  |  |  |  | package Devel::PerlySense::Project; | 
| 27 |  |  |  |  |  |  |  | 
| 28 |  |  |  |  |  |  |  | 
| 29 |  |  |  |  |  |  |  | 
| 30 | 63 |  |  | 63 |  | 2579 | use Spiffy -Base; | 
|  | 63 |  |  |  |  | 5096 |  | 
|  | 63 |  |  |  |  | 285 |  | 
| 31 | 63 |  |  | 63 |  | 158257 | use Carp; | 
|  | 63 |  |  | 63 |  | 76 |  | 
|  | 63 |  |  | 63 |  | 1644 |  | 
|  | 63 |  |  |  |  | 205 |  | 
|  | 63 |  |  |  |  | 72 |  | 
|  | 63 |  |  |  |  | 1624 |  | 
|  | 63 |  |  |  |  | 220 |  | 
|  | 63 |  |  |  |  | 62 |  | 
|  | 63 |  |  |  |  | 3347 |  | 
| 32 | 63 |  |  | 63 |  | 238 | use Data::Dumper; | 
|  | 63 |  |  |  |  | 81 |  | 
|  | 63 |  |  |  |  | 2317 |  | 
| 33 | 63 |  |  | 63 |  | 689 | use File::Basename; | 
|  | 63 |  |  |  |  | 480 |  | 
|  | 63 |  |  |  |  | 3238 |  | 
| 34 | 63 |  |  | 63 |  | 509 | use Path::Class; | 
|  | 63 |  |  |  |  | 30928 |  | 
|  | 63 |  |  |  |  | 2350 |  | 
| 35 | 63 |  |  | 63 |  | 32893 | use File::Slurp; | 
|  | 63 |  |  |  |  | 676819 |  | 
|  | 63 |  |  |  |  | 4415 |  | 
| 36 | 63 |  |  | 63 |  | 23352 | use File::chdir; | 
|  | 63 |  |  |  |  | 111527 |  | 
|  | 63 |  |  |  |  | 6345 |  | 
| 37 | 63 |  |  | 63 |  | 30325 | use Perl::Critic 1.105; | 
|  | 63 |  |  |  |  | 85117707 |  | 
|  | 63 |  |  |  |  | 6406 |  | 
| 38 | 63 |  |  | 63 |  | 473 | use List::MoreUtils qw/ uniq /; | 
|  | 63 |  |  |  |  | 83 |  | 
|  | 63 |  |  |  |  | 3871 |  | 
| 39 |  |  |  |  |  |  |  | 
| 40 | 63 |  |  | 63 |  | 1949 | use Devel::PerlySense; | 
|  | 63 |  |  |  |  | 103 |  | 
|  | 63 |  |  |  |  | 701 |  | 
| 41 | 63 |  |  | 63 |  | 21755 | use Devel::PerlySense::Util; | 
|  | 63 |  |  |  |  | 87 |  | 
|  | 63 |  |  |  |  | 3500 |  | 
| 42 | 63 |  |  | 63 |  | 607 | use Devel::PerlySense::Util::Log; | 
|  | 63 |  |  |  |  | 120 |  | 
|  | 63 |  |  |  |  | 2355 |  | 
| 43 | 63 |  |  | 63 |  | 31731 | use Devel::PerlySense::Config::Project::Default; | 
|  | 63 |  |  |  |  | 134 |  | 
|  | 63 |  |  |  |  | 522 |  | 
| 44 |  |  |  |  |  |  |  | 
| 45 |  |  |  |  |  |  |  | 
| 46 |  |  |  |  |  |  |  | 
| 47 |  |  |  |  |  |  |  | 
| 48 |  |  |  |  |  |  |  | 
| 49 |  |  |  |  |  |  | =head1 PROPERTIES | 
| 50 |  |  |  |  |  |  |  | 
| 51 |  |  |  |  |  |  | =head2 dirProject | 
| 52 |  |  |  |  |  |  |  | 
| 53 |  |  |  |  |  |  | The effective project root dir. | 
| 54 |  |  |  |  |  |  |  | 
| 55 |  |  |  |  |  |  | Readonly. | 
| 56 |  |  |  |  |  |  |  | 
| 57 |  |  |  |  |  |  | =cut | 
| 58 | 1964 |  |  | 1964 | 1 | 6109 | sub dirProject { | 
| 59 |  |  |  |  |  |  | return | 
| 60 | 1964 |  | 66 |  |  | 46795 | $self->dirProjectExplicitDir || | 
| 61 |  |  |  |  |  |  | $self->dirProjectImplicitUse || | 
| 62 |  |  |  |  |  |  | $self->dirProjectImplicitDir; | 
| 63 |  |  |  |  |  |  | } | 
| 64 |  |  |  |  |  |  |  | 
| 65 |  |  |  |  |  |  |  | 
| 66 |  |  |  |  |  |  |  | 
| 67 |  |  |  |  |  |  |  | 
| 68 |  |  |  |  |  |  |  | 
| 69 |  |  |  |  |  |  | =head2 dirProjectExplicitDir | 
| 70 |  |  |  |  |  |  |  | 
| 71 |  |  |  |  |  |  | If known, the root dir made explicit by the existence of a project | 
| 72 |  |  |  |  |  |  | directory and config, else "" | 
| 73 |  |  |  |  |  |  |  | 
| 74 |  |  |  |  |  |  | Default: "" | 
| 75 |  |  |  |  |  |  |  | 
| 76 |  |  |  |  |  |  | =cut | 
| 77 |  |  |  |  |  |  | field "dirProjectExplicitDir" => ""; | 
| 78 |  |  |  |  |  |  |  | 
| 79 |  |  |  |  |  |  |  | 
| 80 |  |  |  |  |  |  |  | 
| 81 |  |  |  |  |  |  |  | 
| 82 |  |  |  |  |  |  |  | 
| 83 |  |  |  |  |  |  | =head2 dirProjectImplicitUse | 
| 84 |  |  |  |  |  |  |  | 
| 85 |  |  |  |  |  |  | If known, the root dir indicated by a found used module, else "". | 
| 86 |  |  |  |  |  |  |  | 
| 87 |  |  |  |  |  |  | Default: "" | 
| 88 |  |  |  |  |  |  |  | 
| 89 |  |  |  |  |  |  | =cut | 
| 90 |  |  |  |  |  |  | field "dirProjectImplicitUse" => ""; | 
| 91 |  |  |  |  |  |  |  | 
| 92 |  |  |  |  |  |  |  | 
| 93 |  |  |  |  |  |  |  | 
| 94 |  |  |  |  |  |  |  | 
| 95 |  |  |  |  |  |  |  | 
| 96 |  |  |  |  |  |  | =head2 dirProjectImplicitDir | 
| 97 |  |  |  |  |  |  |  | 
| 98 |  |  |  |  |  |  | If known, the root dir indicated by the presence of "lib" or "t", else "". | 
| 99 |  |  |  |  |  |  |  | 
| 100 |  |  |  |  |  |  | Default: "" | 
| 101 |  |  |  |  |  |  |  | 
| 102 |  |  |  |  |  |  | =cut | 
| 103 |  |  |  |  |  |  | field "dirProjectImplicitDir" => ""; | 
| 104 |  |  |  |  |  |  |  | 
| 105 |  |  |  |  |  |  |  | 
| 106 |  |  |  |  |  |  |  | 
| 107 |  |  |  |  |  |  |  | 
| 108 |  |  |  |  |  |  |  | 
| 109 |  |  |  |  |  |  | =head2 oConfig | 
| 110 |  |  |  |  |  |  |  | 
| 111 |  |  |  |  |  |  | A Config::Project object with the current Project Config. This gets | 
| 112 |  |  |  |  |  |  | loaded if there is a config file available when the Project is | 
| 113 |  |  |  |  |  |  | identified. | 
| 114 |  |  |  |  |  |  |  | 
| 115 |  |  |  |  |  |  | Default: An Config::Project::Default object | 
| 116 |  |  |  |  |  |  |  | 
| 117 |  |  |  |  |  |  | =cut | 
| 118 |  |  |  |  |  |  | field "oConfig" => Devel::PerlySense::Config::Project::Default->new(); | 
| 119 |  |  |  |  |  |  |  | 
| 120 |  |  |  |  |  |  |  | 
| 121 |  |  |  |  |  |  |  | 
| 122 |  |  |  |  |  |  |  | 
| 123 |  |  |  |  |  |  |  | 
| 124 |  |  |  |  |  |  | =head2 rhConfig | 
| 125 |  |  |  |  |  |  |  | 
| 126 |  |  |  |  |  |  | The actual hashref with config values. | 
| 127 |  |  |  |  |  |  |  | 
| 128 |  |  |  |  |  |  | Readonly (that includes the entire data structure). | 
| 129 |  |  |  |  |  |  |  | 
| 130 |  |  |  |  |  |  | =cut | 
| 131 | 1300 |  |  | 1300 | 1 | 5052 | sub rhConfig { | 
| 132 | 1300 |  |  |  |  | 36701 | return $self->oConfig->rhConfig; | 
| 133 |  |  |  |  |  |  | } | 
| 134 |  |  |  |  |  |  |  | 
| 135 |  |  |  |  |  |  |  | 
| 136 |  |  |  |  |  |  |  | 
| 137 |  |  |  |  |  |  |  | 
| 138 |  |  |  |  |  |  |  | 
| 139 |  |  |  |  |  |  | =head2 oPerlySense | 
| 140 |  |  |  |  |  |  |  | 
| 141 |  |  |  |  |  |  | Devel::PerlySense object. | 
| 142 |  |  |  |  |  |  |  | 
| 143 |  |  |  |  |  |  | =cut | 
| 144 |  |  |  |  |  |  | field "oPerlySense" => undef; | 
| 145 |  |  |  |  |  |  |  | 
| 146 |  |  |  |  |  |  |  | 
| 147 |  |  |  |  |  |  |  | 
| 148 |  |  |  |  |  |  |  | 
| 149 |  |  |  |  |  |  |  | 
| 150 |  |  |  |  |  |  | =head2 nameVcs | 
| 151 |  |  |  |  |  |  |  | 
| 152 |  |  |  |  |  |  | The name of the Version Control system for the project. | 
| 153 |  |  |  |  |  |  |  | 
| 154 |  |  |  |  |  |  | Readonly. Currently supported: | 
| 155 |  |  |  |  |  |  |  | 
| 156 |  |  |  |  |  |  | git | 
| 157 |  |  |  |  |  |  | svn | 
| 158 |  |  |  |  |  |  | none | 
| 159 |  |  |  |  |  |  |  | 
| 160 |  |  |  |  |  |  | In that order, so that if there's a Git repo on top of a SVN repo, git | 
| 161 |  |  |  |  |  |  | is found. | 
| 162 |  |  |  |  |  |  |  | 
| 163 |  |  |  |  |  |  | =cut | 
| 164 | 1 |  |  | 1 | 1 | 1 | sub nameVcs { | 
| 165 |  |  |  |  |  |  |  | 
| 166 |  |  |  |  |  |  | #Git | 
| 167 | 1 | 50 |  |  |  | 23 | $self->oPerlySense->dirFindLookingAround( | 
| 168 |  |  |  |  |  |  | ".git", | 
| 169 |  |  |  |  |  |  | $self->dirProject, | 
| 170 |  |  |  |  |  |  | ["."], | 
| 171 |  |  |  |  |  |  | ) and return("git"); | 
| 172 |  |  |  |  |  |  |  | 
| 173 |  |  |  |  |  |  | #Subversion | 
| 174 | 0 | 0 |  |  |  | 0 | -d dir($self->dirProject, ".svn") and return("svn"); | 
| 175 |  |  |  |  |  |  |  | 
| 176 | 0 |  |  |  |  | 0 | return("none"); | 
| 177 |  |  |  |  |  |  | } | 
| 178 |  |  |  |  |  |  |  | 
| 179 |  |  |  |  |  |  |  | 
| 180 |  |  |  |  |  |  |  | 
| 181 |  |  |  |  |  |  |  | 
| 182 |  |  |  |  |  |  |  | 
| 183 |  |  |  |  |  |  | =head1 CLASS METHODS | 
| 184 |  |  |  |  |  |  |  | 
| 185 |  |  |  |  |  |  | =head2 newFromLocation(file => $file, dir => $dir, oPerlySense => $oPs) | 
| 186 |  |  |  |  |  |  |  | 
| 187 |  |  |  |  |  |  | Create new Project given either $file, or $dir. | 
| 188 |  |  |  |  |  |  |  | 
| 189 |  |  |  |  |  |  | First, search for an explicit project root directory, then try to find | 
| 190 |  |  |  |  |  |  | any modules used in $file (if passed), then try to find any "lib" or | 
| 191 |  |  |  |  |  |  | "t" directory upwards of $file or $dir. | 
| 192 |  |  |  |  |  |  |  | 
| 193 |  |  |  |  |  |  | $file takes precedence over $dir if both are specified. | 
| 194 |  |  |  |  |  |  |  | 
| 195 |  |  |  |  |  |  | If none if this works out, no Project can be created and undef is | 
| 196 |  |  |  |  |  |  | returned. | 
| 197 |  |  |  |  |  |  |  | 
| 198 |  |  |  |  |  |  | Return the new object, or undef if no project could be found. | 
| 199 |  |  |  |  |  |  |  | 
| 200 |  |  |  |  |  |  | =cut | 
| 201 |  |  |  |  |  |  | sub newFromLocation(@) { | 
| 202 | 59 |  |  | 59 | 1 | 112 | my $pkg = shift; | 
| 203 | 59 |  |  |  |  | 591 | my ($oPerlySense) = Devel::PerlySense::Util::aNamedArg(["oPerlySense"], @_); | 
| 204 | 59 |  |  |  |  | 207 | my %p = @_; | 
| 205 | 59 |  |  |  |  | 139 | my $file = $p{file}; | 
| 206 | 59 |  |  |  |  | 99 | my $dir = $p{dir}; | 
| 207 | 59 | 100 |  |  |  | 747 | $file and $dir = dirname($file); | 
| 208 | 59 | 50 |  |  |  | 400 | $dir and $dir = dir($dir)->absolute; | 
| 209 |  |  |  |  |  |  |  | 
| 210 | 59 |  |  |  |  | 18053 | my $oProject; | 
| 211 |  |  |  |  |  |  |  | 
| 212 | 59 | 100 | 66 |  |  | 193 | $dir and $oProject = $pkg->newFindExplicit( | 
| 213 |  |  |  |  |  |  | dir => $dir, | 
| 214 |  |  |  |  |  |  | oPerlySense => $oPerlySense, | 
| 215 |  |  |  |  |  |  | ) and return $oProject; | 
| 216 |  |  |  |  |  |  |  | 
| 217 |  |  |  |  |  |  |  | 
| 218 |  |  |  |  |  |  | #If file, look for the dir from where any package in the file can | 
| 219 |  |  |  |  |  |  | #be used | 
| 220 | 7 | 100 | 66 |  |  | 35 | if($file and my $oDocument = $oPerlySense->oDocumentParseFile($file)) { | 
| 221 | 4 |  |  |  |  | 18 | for my $package ($oDocument->aNamePackage) { | 
| 222 | 2 |  |  |  |  | 90 | my $filePackage = $oPerlySense->fileFromModule($package); | 
| 223 | 2 |  |  |  |  | 563 | my $dirFound = $oPerlySense->dirFindLookingAround($filePackage, $dir); | 
| 224 |  |  |  |  |  |  |  | 
| 225 | 2 | 50 |  |  |  | 270 | if($dirFound) { | 
| 226 | 2 |  |  |  |  | 5 | my $dirProject = dir($dirFound)->parent . ""; ###TODO: if lib or bin | 
| 227 | 2 |  |  |  |  | 292 | return $pkg->new( | 
| 228 |  |  |  |  |  |  | oPerlySense => $oPerlySense, | 
| 229 |  |  |  |  |  |  | dirProjectImplicitUse => $dirProject, | 
| 230 |  |  |  |  |  |  | ); | 
| 231 |  |  |  |  |  |  | } | 
| 232 |  |  |  |  |  |  | } | 
| 233 |  |  |  |  |  |  | } | 
| 234 |  |  |  |  |  |  |  | 
| 235 |  |  |  |  |  |  | #If dir, look for dirs | 
| 236 | 5 | 50 |  |  |  | 209 | if($dir) { | 
| 237 | 5 |  | 66 |  |  | 39 | my $dirFound = | 
| 238 |  |  |  |  |  |  | $oPerlySense->fileFindLookingAround("lib", $dir) || | 
| 239 |  |  |  |  |  |  | $oPerlySense->fileFindLookingAround("t", $dir); | 
| 240 |  |  |  |  |  |  |  | 
| 241 | 5 | 100 |  |  |  | 519 | if($dirFound) { | 
| 242 | 3 |  |  |  |  | 9 | my $dirProject = dir($dirFound)->parent . ""; ###TODO: if lib or bin | 
| 243 |  |  |  |  |  |  |  | 
| 244 |  |  |  |  |  |  | #Special case the Unix style root dir. It's never a | 
| 245 |  |  |  |  |  |  | #Project dir, but if often contains a lib dir and so will | 
| 246 |  |  |  |  |  |  | #get identified as a Project. | 
| 247 |  |  |  |  |  |  | # | 
| 248 |  |  |  |  |  |  | #If it _is_ a root dir, this can be overriden with an | 
| 249 |  |  |  |  |  |  | #explicit .PerlySenseProject dir. | 
| 250 |  |  |  |  |  |  | # | 
| 251 |  |  |  |  |  |  | #On Windows, the root looks like X:\, and it's not | 
| 252 |  |  |  |  |  |  | #entirely unlikely that a secondary drive or a SUBST drive | 
| 253 |  |  |  |  |  |  | #letter contains the project root. | 
| 254 | 3 | 50 |  |  |  | 400 | $dirProject eq "/" and return undef; | 
| 255 |  |  |  |  |  |  |  | 
| 256 | 3 |  |  |  |  | 27 | return $pkg->new( | 
| 257 |  |  |  |  |  |  | oPerlySense => $oPerlySense, | 
| 258 |  |  |  |  |  |  | dirProjectImplicitDir => $dirProject, | 
| 259 |  |  |  |  |  |  | ); | 
| 260 |  |  |  |  |  |  | } | 
| 261 |  |  |  |  |  |  | } | 
| 262 |  |  |  |  |  |  |  | 
| 263 | 2 |  |  |  |  | 14 | return(undef); | 
| 264 |  |  |  |  |  |  | } | 
| 265 |  |  |  |  |  |  |  | 
| 266 |  |  |  |  |  |  |  | 
| 267 |  |  |  |  |  |  |  | 
| 268 |  |  |  |  |  |  |  | 
| 269 |  |  |  |  |  |  |  | 
| 270 |  |  |  |  |  |  | =head2 newFindExplicit(dir => $dir, oPerlySense => $oPs) | 
| 271 |  |  |  |  |  |  |  | 
| 272 |  |  |  |  |  |  | Create new Project if there is an explicit .PerlySenseProject | 
| 273 |  |  |  |  |  |  | directory in the path above $dir. | 
| 274 |  |  |  |  |  |  |  | 
| 275 |  |  |  |  |  |  | Return the new object, or undef if no project could be found. | 
| 276 |  |  |  |  |  |  |  | 
| 277 |  |  |  |  |  |  | =cut | 
| 278 |  |  |  |  |  |  | sub newFindExplicit(@) { | 
| 279 | 54 |  |  | 54 | 1 | 580 | my $pkg = shift; | 
| 280 | 54 |  |  |  |  | 253 | my ($oPerlySense, $dir) = Devel::PerlySense::Util::aNamedArg(["oPerlySense", "dir"], @_); | 
| 281 |  |  |  |  |  |  |  | 
| 282 | 54 | 100 |  |  |  | 313 | if(my $dirProject = $oPerlySense->dirFindLookingAround( | 
| 283 |  |  |  |  |  |  | ".PerlySenseProject", | 
| 284 |  |  |  |  |  |  | $dir, | 
| 285 |  |  |  |  |  |  | ["."], | 
| 286 |  |  |  |  |  |  | )) { | 
| 287 | 52 |  |  |  |  | 2874 | return $pkg->new( | 
| 288 |  |  |  |  |  |  | oPerlySense => $oPerlySense, | 
| 289 |  |  |  |  |  |  | dirProjectExplicitDir => $dirProject, | 
| 290 |  |  |  |  |  |  | oConfig => Devel::PerlySense::Config::Project->new(dirRoot => $dirProject), | 
| 291 |  |  |  |  |  |  | ); | 
| 292 |  |  |  |  |  |  | } | 
| 293 |  |  |  |  |  |  |  | 
| 294 | 2 |  |  |  |  | 18 | return undef; | 
| 295 |  |  |  |  |  |  | } | 
| 296 |  |  |  |  |  |  |  | 
| 297 |  |  |  |  |  |  |  | 
| 298 |  |  |  |  |  |  |  | 
| 299 |  |  |  |  |  |  |  | 
| 300 |  |  |  |  |  |  |  | 
| 301 |  |  |  |  |  |  | =head1 MEHTODS | 
| 302 |  |  |  |  |  |  |  | 
| 303 |  |  |  |  |  |  | =head2 rhRunFile(file => $fileSource, [rhConfigType = DEDUCED_FROM_FILE], [ keyConfigCommand = "command" ]) | 
| 304 |  |  |  |  |  |  |  | 
| 305 |  |  |  |  |  |  | Like rhRunFile0, but with what => "run". | 
| 306 |  |  |  |  |  |  |  | 
| 307 |  |  |  |  |  |  | =cut | 
| 308 | 4 |  |  | 4 | 1 | 18 | sub rhRunFile { | 
| 309 | 4 |  |  |  |  | 12 | my ($file) = Devel::PerlySense::Util::aNamedArg(["file"], @_); | 
| 310 | 4 |  |  |  |  | 9 | my %p = @_; | 
| 311 | 4 |  |  |  |  | 14 | return( $self->rhRunFile0(%p, what => "run") ); | 
| 312 |  |  |  |  |  |  | } | 
| 313 |  |  |  |  |  |  |  | 
| 314 |  |  |  |  |  |  |  | 
| 315 |  |  |  |  |  |  |  | 
| 316 |  |  |  |  |  |  |  | 
| 317 |  |  |  |  |  |  |  | 
| 318 |  |  |  |  |  |  | =head2 rhDebugFile(file => $fileSource, [rhConfigType = DEDUCED_FROM_FILE], [ keyConfigCommand = "command" ]) | 
| 319 |  |  |  |  |  |  |  | 
| 320 |  |  |  |  |  |  | Like rhRunFile0, but with what => "debug". | 
| 321 |  |  |  |  |  |  |  | 
| 322 |  |  |  |  |  |  | =cut | 
| 323 |  |  |  |  |  |  | ### XXX refactor, DRY with rhRunFile | 
| 324 | 1 |  |  | 1 | 1 | 5 | sub rhDebugFile { | 
| 325 | 1 |  |  |  |  | 5 | my ($file) = Devel::PerlySense::Util::aNamedArg(["file"], @_); | 
| 326 | 1 |  |  |  |  | 3 | my %p = @_; | 
| 327 | 1 |  |  |  |  | 6 | return( $self->rhRunFile0(%p, what => "debug") ); | 
| 328 |  |  |  |  |  |  | } | 
| 329 |  |  |  |  |  |  |  | 
| 330 |  |  |  |  |  |  |  | 
| 331 |  |  |  |  |  |  |  | 
| 332 |  |  |  |  |  |  |  | 
| 333 |  |  |  |  |  |  |  | 
| 334 |  |  |  |  |  |  | =head2 rhRunFile0(file => $fileSource, what => "run" | "debug", [rhConfigType = DEDUCED_FROM_FILE], [ keyConfigCommand = "command" ]) | 
| 335 |  |  |  |  |  |  |  | 
| 336 |  |  |  |  |  |  | Figure out what type of source file $fileSource is, and how it should | 
| 337 |  |  |  |  |  |  | be run/debugged. | 
| 338 |  |  |  |  |  |  |  | 
| 339 |  |  |  |  |  |  | The settings in the global config->{$what_file} is used to determine | 
| 340 |  |  |  |  |  |  | the details. | 
| 341 |  |  |  |  |  |  |  | 
| 342 |  |  |  |  |  |  | The command to use is taken from | 
| 343 |  |  |  |  |  |  | config->{$what_file}->{$keyConfigCommand}, if that is specified, | 
| 344 |  |  |  |  |  |  | otherwise for "command". | 
| 345 |  |  |  |  |  |  |  | 
| 346 |  |  |  |  |  |  | Return hash ref with (keys: "dir_$what_from", "command_$what", | 
| 347 |  |  |  |  |  |  | "type_source_file"), or die on errors (like if no Project could be | 
| 348 |  |  |  |  |  |  | found). | 
| 349 |  |  |  |  |  |  |  | 
| 350 |  |  |  |  |  |  | dir_$what_from is an absolute directory name which should be the cwd | 
| 351 |  |  |  |  |  |  | when command_$what is executed. | 
| 352 |  |  |  |  |  |  |  | 
| 353 |  |  |  |  |  |  | type_source_file is something like "Test", "Module". | 
| 354 |  |  |  |  |  |  |  | 
| 355 |  |  |  |  |  |  | =cut | 
| 356 | 5 |  |  | 5 | 1 | 5 | sub rhRunFile0 { | 
| 357 | 5 |  |  |  |  | 16 | my ($file) = Devel::PerlySense::Util::aNamedArg(["file"], @_); | 
| 358 | 5 |  |  |  |  | 13 | my %p = @_; | 
| 359 | 5 |  |  |  |  | 8 | my $rhConfigType = $p{rhConfigType}; | 
| 360 | 5 |  |  |  |  | 6 | my $what = $p{what}; | 
| 361 | 5 |  | 100 |  |  | 20 | my $keyConfigCommand = $p{keyConfigCommand} || "command"; | 
| 362 |  |  |  |  |  |  |  | 
| 363 | 5 |  |  |  |  | 9 | $file = file($file)->absolute; | 
| 364 | 5 |  | 33 |  |  | 1272 | $rhConfigType ||= $self->rhConfigTypeForFile( | 
| 365 |  |  |  |  |  |  | file      => $file, | 
| 366 |  |  |  |  |  |  | keyConfig => "${what}_file", | 
| 367 |  |  |  |  |  |  | ); | 
| 368 |  |  |  |  |  |  |  | 
| 369 | 5 |  |  |  |  | 199 | my $dirProject = dir($self->dirProject)->absolute; | 
| 370 |  |  |  |  |  |  | my %hTypeDirRunFrom = ( | 
| 371 | 3 |  |  | 3 |  | 5 | source_root_directory => sub { $dirProject }, | 
| 372 | 2 |  |  | 2 |  | 6 | file_directory        => sub { $file->dir }, | 
| 373 | 5 |  |  |  |  | 486 | ); | 
| 374 | 5 |  |  |  |  | 13 | my $typeRunFrom = $rhConfigType->{"${what}_from"}; | 
| 375 | 5 | 50 |  |  |  | 12 | my $rsDirRunFrom = $hTypeDirRunFrom{$typeRunFrom} or die("Invalid ${what}_from value ($typeRunFrom)\n" . Dumper($rhConfigType) . "Allowed values: (" . join(", ", (sort keys %hTypeDirRunFrom)) . ")\n"); | 
| 376 | 5 |  |  |  |  | 7 | my $dirRunFrom = $rsDirRunFrom->(); | 
| 377 |  |  |  |  |  |  |  | 
| 378 | 5 |  |  |  |  | 18 | my @aDirIncProject = $self->aDirIncProject(dirRelativeTo => $dirRunFrom); | 
| 379 | 5 |  |  |  |  | 11 | my $optionInc = join(" ", map { qq|"-I$_"| } @aDirIncProject); | 
|  | 19 |  |  |  |  | 30 |  | 
| 380 |  |  |  |  |  |  |  | 
| 381 | 5 |  |  |  |  | 23 | my $fileSource = $file->relative($dirRunFrom); | 
| 382 | 5 | 50 | 33 |  |  | 1584 | my $command | 
| 383 |  |  |  |  |  |  | =  $rhConfigType->{ $keyConfigCommand } | 
| 384 |  |  |  |  |  |  | || $rhConfigType->{command} | 
| 385 |  |  |  |  |  |  | or die("Could not find a config value for which 'command' to run\n"); | 
| 386 | 5 |  |  |  |  | 12 | my $commandRun = textRenderTemplate( | 
| 387 |  |  |  |  |  |  | $command, | 
| 388 |  |  |  |  |  |  | { | 
| 389 |  |  |  |  |  |  | INC         => $optionInc, | 
| 390 |  |  |  |  |  |  | SOURCE_FILE => $fileSource . "", | 
| 391 |  |  |  |  |  |  | }, | 
| 392 |  |  |  |  |  |  | ); | 
| 393 |  |  |  |  |  |  |  | 
| 394 | 5 |  |  |  |  | 23 | my $rhConfigRun = { | 
| 395 |  |  |  |  |  |  | "dir_${what}_from" => $dirRunFrom . "", | 
| 396 |  |  |  |  |  |  | "command_${what}"  => $commandRun, | 
| 397 |  |  |  |  |  |  | type_source_file   => $rhConfigType->{moniker}, | 
| 398 |  |  |  |  |  |  | }; | 
| 399 | 5 |  |  |  |  | 180 | return($rhConfigRun); | 
| 400 |  |  |  |  |  |  | } | 
| 401 |  |  |  |  |  |  |  | 
| 402 |  |  |  |  |  |  |  | 
| 403 |  |  |  |  |  |  |  | 
| 404 |  |  |  |  |  |  |  | 
| 405 |  |  |  |  |  |  |  | 
| 406 |  |  |  |  |  |  | =head2 rhConfigTypeForFile(file => $fileSource, keyConfig => CONFIG_KEY) | 
| 407 |  |  |  |  |  |  |  | 
| 408 |  |  |  |  |  |  | Return the config type hash ref (keys: command, moniker) from the ones | 
| 409 |  |  |  |  |  |  | available in the config. Match the $fileSource name against each rex | 
| 410 |  |  |  |  |  |  | in the config. | 
| 411 |  |  |  |  |  |  |  | 
| 412 |  |  |  |  |  |  | Die if no configType could be identified. | 
| 413 |  |  |  |  |  |  |  | 
| 414 |  |  |  |  |  |  | =cut | 
| 415 | 19 |  |  | 19 | 1 | 20 | sub rhConfigTypeForFile { | 
| 416 | 19 |  |  |  |  | 55 | my ($file, $keyConfig) = Devel::PerlySense::Util::aNamedArg(["file", "keyConfig"], @_); | 
| 417 |  |  |  |  |  |  |  | 
| 418 | 19 |  |  |  |  | 483 | my $rhConfig = $self->oPerlySense->rhConfig; | 
| 419 | 19 |  |  |  |  | 583 | for my $rhConfigType (@{ $rhConfig->{ $keyConfig } }) { | 
|  | 19 |  |  |  |  | 30 |  | 
| 420 | 33 | 100 |  |  |  | 62 | my $rex = $rhConfigType->{rex} | 
| 421 |  |  |  |  |  |  | or die("Missing rex key in config chunk: " . Dumper($rhConfigType)); | 
| 422 |  |  |  |  |  |  |  | 
| 423 | 31 | 100 |  |  |  | 23 | eval { $file =~ /$rex/ } and return $rhConfigType; | 
|  | 31 |  |  |  |  | 280 |  | 
| 424 | 18 | 100 |  |  |  | 176 | $@ and die("Invalid rex value in config chunk.\nError: $@\n" . Dumper($rhConfigType)); | 
| 425 |  |  |  |  |  |  | } | 
| 426 |  |  |  |  |  |  |  | 
| 427 | 2 |  |  |  |  | 14 | die("No run_perl rex matched the file ($file). Please check your config\n"); | 
| 428 |  |  |  |  |  |  | } | 
| 429 |  |  |  |  |  |  |  | 
| 430 |  |  |  |  |  |  |  | 
| 431 |  |  |  |  |  |  |  | 
| 432 |  |  |  |  |  |  |  | 
| 433 |  |  |  |  |  |  |  | 
| 434 |  |  |  |  |  |  | =head2 aDirIncProject(dirRelativeTo => $dirRelativeTo) | 
| 435 |  |  |  |  |  |  |  | 
| 436 |  |  |  |  |  |  | Return array with dir objects which are the inc_dir directories in the | 
| 437 |  |  |  |  |  |  | config, plus the usual inc directories. They are all relative to | 
| 438 |  |  |  |  |  |  | $dirRelativeTo. | 
| 439 |  |  |  |  |  |  |  | 
| 440 |  |  |  |  |  |  | =cut | 
| 441 | 717 |  |  | 717 | 1 | 9645 | sub aDirIncProject { | 
| 442 | 717 |  |  |  |  | 2319 | my ($dirRelativeTo) = Devel::PerlySense::Util::aNamedArg(["dirRelativeTo"], @_); | 
| 443 |  |  |  |  |  |  |  | 
| 444 | 717 |  |  |  |  | 1796 | my $dirProject = dir($self->dirProject)->absolute; | 
| 445 | 717 |  |  |  |  | 54201 | my $dirProjectRelativeTo = $dirProject->relative( $dirRelativeTo ); | 
| 446 |  |  |  |  |  |  |  | 
| 447 |  |  |  |  |  |  | ###TODO: extract method for the inc_dir config entry aIncDirConfig | 
| 448 | 717 | 50 |  |  |  | 100265 | my @aDirIncProject = @{ $self->oPerlySense->rhConfig->{project}->{inc_dir} || [] }; | 
|  | 717 |  |  |  |  | 23901 |  | 
| 449 | 717 |  |  |  |  | 26280 | my @aDirInc = (@aDirIncProject, ".", "lib"); | 
| 450 |  |  |  |  |  |  |  | 
| 451 | 1443 |  |  |  |  | 54948 | my @aDirIncRelative = | 
| 452 | 717 |  |  |  |  | 1148 | map { dir($dirProjectRelativeTo, $_) . "" } | 
| 453 |  |  |  |  |  |  | @aDirInc; | 
| 454 |  |  |  |  |  |  |  | 
| 455 | 717 |  |  |  |  | 55292 | return @aDirIncRelative; | 
| 456 |  |  |  |  |  |  | } | 
| 457 |  |  |  |  |  |  |  | 
| 458 |  |  |  |  |  |  |  | 
| 459 |  |  |  |  |  |  |  | 
| 460 |  |  |  |  |  |  |  | 
| 461 |  |  |  |  |  |  |  | 
| 462 |  |  |  |  |  |  | =head2 aDirIncAbsolute() | 
| 463 |  |  |  |  |  |  |  | 
| 464 |  |  |  |  |  |  | Return array with absolute dir objects which are the inc_dir | 
| 465 |  |  |  |  |  |  | directories in the config, plus the usual inc directories. | 
| 466 |  |  |  |  |  |  |  | 
| 467 |  |  |  |  |  |  | =cut | 
| 468 | 534 |  |  | 534 | 1 | 3276 | sub aDirIncAbsolute { | 
| 469 | 534 |  |  |  |  | 1930 | my $dirProject = dir($self->dirProject)->absolute; | 
| 470 |  |  |  |  |  |  |  | 
| 471 |  |  |  |  |  |  | ###TODO: extract method for the inc_dir config entry aIncDirConfig | 
| 472 | 534 | 50 |  |  |  | 14154 | my @aDirIncProject = @{ | 
| 473 | 534 |  |  |  |  | 39243 | $self->oPerlySense->rhConfig->{project}->{inc_dir} || [] | 
| 474 |  |  |  |  |  |  | }; | 
| 475 | 534 |  |  |  |  | 19750 | my @aDirInc = (@aDirIncProject, ".", "lib"); | 
| 476 |  |  |  |  |  |  |  | 
| 477 | 1071 |  |  |  |  | 54332 | my @aDirIncAbsolute = | 
| 478 | 534 |  |  |  |  | 875 | map { dir($dirProject, $_)->absolute . "" } | 
| 479 |  |  |  |  |  |  | @aDirInc; | 
| 480 | 534 |  |  |  |  | 56687 | return @aDirIncAbsolute; | 
| 481 |  |  |  |  |  |  | } | 
| 482 |  |  |  |  |  |  |  | 
| 483 |  |  |  |  |  |  |  | 
| 484 |  |  |  |  |  |  |  | 
| 485 |  |  |  |  |  |  |  | 
| 486 |  |  |  |  |  |  |  | 
| 487 |  |  |  |  |  |  | =head2 isFileInProject(file => $file) | 
| 488 |  |  |  |  |  |  |  | 
| 489 |  |  |  |  |  |  | Return true if $file is within the project root, or in any of the INC | 
| 490 |  |  |  |  |  |  | directories, else false. Die on errors. | 
| 491 |  |  |  |  |  |  |  | 
| 492 |  |  |  |  |  |  | Test logically/structurally, not whether the file actually exists. | 
| 493 |  |  |  |  |  |  |  | 
| 494 |  |  |  |  |  |  | =cut | 
| 495 | 7 |  |  | 7 | 1 | 17 | sub isFileInProject { | 
| 496 | 7 |  |  |  |  | 28 | my ($file) = Devel::PerlySense::Util::aNamedArg(["file"], @_); | 
| 497 |  |  |  |  |  |  |  | 
| 498 | 15 |  |  |  |  | 695 | my @aDirInc = | 
| 499 | 7 | 50 |  |  |  | 186 | map { dir($self->dirProject, $_) } | 
| 500 | 7 |  |  |  |  | 13 | @{ $self->oPerlySense->rhConfig->{project}->{inc_dir} || [] }; | 
| 501 | 22 |  |  |  |  | 2758 | my @aDirSourceAbsolute = | 
| 502 | 7 |  |  |  |  | 322 | map { dir($_)->absolute } | 
| 503 |  |  |  |  |  |  | ($self->dirProject, @aDirInc); | 
| 504 |  |  |  |  |  |  |  | 
| 505 |  |  |  |  |  |  | ###TODO: Comment out  debug statements when that failing test in t/PerlySense-Project-file-in-project.t is fixed | 
| 506 | 7 |  |  |  |  | 1063 | debug("\nTESTING WHETHER FILE\n($file) IS IN PROJECT\n(" . $self->dirProject . "),\ni.e.\n(" . join(")\n(", @aDirSourceAbsolute) . ")\n"); | 
| 507 | 7 |  |  |  |  | 20 | my @aDirProjectRegex = map { qr/^ \Q$_\E /x } @aDirSourceAbsolute; | 
|  | 22 |  |  |  |  | 529 |  | 
| 508 |  |  |  |  |  |  |  | 
| 509 | 7 |  |  |  |  | 249 | my $dirFileAbsolute = dir( filePathNormalize( file($file)->absolute->dir ) ); | 
| 510 | 7 |  |  |  |  | 1150 | debug("DIR ABSOLUTE ($dirFileAbsolute)\n"); | 
| 511 |  |  |  |  |  |  |  | 
| 512 | 7 |  |  |  |  | 15 | for my $dirProject (map { dir(filePathNormalize($_)) } @aDirSourceAbsolute) { | 
|  | 22 |  |  |  |  | 2753 |  | 
| 513 | 16 |  |  |  |  | 3381 | debug("Checking whether\n($dirFileAbsolute) is within\n($dirProject)\n"); | 
| 514 | 16 | 100 |  |  |  | 47 | $dirProject->subsumes($dirFileAbsolute) and debug("Found it"), return 1; | 
| 515 |  |  |  |  |  |  | } | 
| 516 |  |  |  |  |  |  |  | 
| 517 | 3 |  |  |  |  | 987 | debug("FILE ($file) is NOT in the Project (" . $self->dirProject . ")\n"); | 
| 518 | 3 |  |  |  |  | 720 | return 0; | 
| 519 |  |  |  |  |  |  | } | 
| 520 |  |  |  |  |  |  |  | 
| 521 |  |  |  |  |  |  |  | 
| 522 |  |  |  |  |  |  |  | 
| 523 |  |  |  |  |  |  |  | 
| 524 |  |  |  |  |  |  |  | 
| 525 |  |  |  |  |  |  | =head2 flymakeFile(file => $fileSource) | 
| 526 |  |  |  |  |  |  |  | 
| 527 |  |  |  |  |  |  | Do a flymake run with $fileSource according to the flymake config and | 
| 528 |  |  |  |  |  |  | output the result to STDOUT and STDERR. | 
| 529 |  |  |  |  |  |  |  | 
| 530 |  |  |  |  |  |  | Return 1 or die on errors (but that will look like the result of a | 
| 531 |  |  |  |  |  |  | failed flymake run). | 
| 532 |  |  |  |  |  |  |  | 
| 533 |  |  |  |  |  |  | =cut | 
| 534 |  |  |  |  |  |  |  | 
| 535 | 0 |  |  | 0 | 1 |  | sub flymakeFile { | 
| 536 | 0 |  |  |  |  |  | my ($file) = Devel::PerlySense::Util::aNamedArg(["file"], @_); | 
| 537 |  |  |  |  |  |  |  | 
| 538 | 0 | 0 |  |  |  |  | if($self->oPerlySense->rhConfig->{external}{editor}{emacs}{flymake}{syntax}) { | 
| 539 | 0 |  |  |  |  |  | my $rhConfigRun = $self->rhRunFile( | 
| 540 |  |  |  |  |  |  | file => $file, | 
| 541 |  |  |  |  |  |  | rhConfigType =>  { | 
| 542 |  |  |  |  |  |  | command => q{perl -c ${INC} "${SOURCE_FILE}" 2>&1 | perl -ne " /Subroutine [\\w:]+ redefined at/ or print"}, | 
| 543 |  |  |  |  |  |  | moniker => "Flymake", | 
| 544 |  |  |  |  |  |  | rex => "", | 
| 545 |  |  |  |  |  |  | run_from => "file_directory", | 
| 546 |  |  |  |  |  |  | }, | 
| 547 |  |  |  |  |  |  | ); | 
| 548 |  |  |  |  |  |  |  | 
| 549 | 0 |  |  |  |  |  | local $CWD = $rhConfigRun->{dir_run_from}; | 
| 550 | 0 |  |  |  |  |  | system( $rhConfigRun->{command_run} ); | 
| 551 |  |  |  |  |  |  | } | 
| 552 |  |  |  |  |  |  |  | 
| 553 | 0 | 0 |  |  |  |  | if($self->oPerlySense->rhConfig->{external}{editor}{emacs}{flymake}{critic}) { | 
| 554 |  |  |  |  |  |  | ###TODO: don't run if syntax errors found | 
| 555 |  |  |  |  |  |  |  | 
| 556 | 0 |  |  |  |  |  | my $fileConfigCritic = file( | 
| 557 |  |  |  |  |  |  | dir($self->dirProject)->absolute, ".PerlySenseProject", ".perlcritic", | 
| 558 |  |  |  |  |  |  | ); | 
| 559 |  |  |  |  |  |  |  | 
| 560 | 0 |  |  |  |  |  | my @aOption = (-profile => $fileConfigCritic . ""); | 
| 561 | 0 | 0 |  |  |  |  | -e $fileConfigCritic or @aOption = (); | 
| 562 |  |  |  |  |  |  |  | 
| 563 | 0 |  |  |  |  |  | my $oCritic = Perl::Critic->new(@aOption); | 
| 564 |  |  |  |  |  |  |  | 
| 565 | 0 |  |  |  |  |  | my @aViolation = $oCritic->critique($file); | 
| 566 |  |  |  |  |  |  |  | 
| 567 | 0 |  |  |  |  |  | Perl::Critic::Violation::set_format( "%m near '%r' (%e, %p) at %f line %l.\n" ); | 
| 568 | 0 |  |  |  |  |  | for my $violation (@aViolation) { | 
| 569 | 0 |  |  |  |  |  | print STDERR "Warning: $violation"; | 
| 570 |  |  |  |  |  |  | } | 
| 571 |  |  |  |  |  |  | } | 
| 572 |  |  |  |  |  |  |  | 
| 573 | 0 |  |  |  |  |  | return 1; | 
| 574 |  |  |  |  |  |  | } | 
| 575 |  |  |  |  |  |  |  | 
| 576 |  |  |  |  |  |  |  | 
| 577 |  |  |  |  |  |  |  | 
| 578 |  |  |  |  |  |  |  | 
| 579 |  |  |  |  |  |  |  | 
| 580 |  |  |  |  |  |  | =head2 rhSubCovered(file => $fileSource) | 
| 581 |  |  |  |  |  |  |  | 
| 582 |  |  |  |  |  |  | Do a "covered subs" call with $fileSource. | 
| 583 |  |  |  |  |  |  |  | 
| 584 |  |  |  |  |  |  | Die if Devel::CoverX::Covered isn't installed. | 
| 585 |  |  |  |  |  |  |  | 
| 586 |  |  |  |  |  |  | Return hash ref with (keys: sub name; values: quality)), or an empty | 
| 587 |  |  |  |  |  |  | hash ref if no coverage info was found for $fileSource. | 
| 588 |  |  |  |  |  |  |  | 
| 589 |  |  |  |  |  |  | Any subs with the same name will have their qualities combined. | 
| 590 |  |  |  |  |  |  |  | 
| 591 |  |  |  |  |  |  | =cut | 
| 592 | 0 |  |  | 0 | 1 |  | sub rhSubCovered { | 
| 593 | 0 |  |  |  |  |  | my ($file) = Devel::PerlySense::Util::aNamedArg(["file"], @_); | 
| 594 |  |  |  |  |  |  |  | 
| 595 | 0 |  |  |  |  |  | local $CWD = $self->dirProject; | 
| 596 |  |  |  |  |  |  |  | 
| 597 | 0 |  |  |  |  |  | eval { | 
| 598 | 0 |  |  |  |  |  | require Devel::CoverX::Covered; | 
| 599 | 0 |  |  |  |  |  | require Devel::CoverX::Covered::Db; | 
| 600 |  |  |  |  |  |  | }; | 
| 601 | 0 | 0 |  |  |  |  | $@ and die("Devel::CoverX::Covered isn't installed\n"); | 
| 602 |  |  |  |  |  |  |  | 
| 603 |  |  |  |  |  |  | ###TODO: use dir specified in config and/or on command line | 
| 604 | 0 |  |  |  |  |  | local $CWD = $self->dirProject . ""; | 
| 605 |  |  |  |  |  |  |  | 
| 606 |  |  |  |  |  |  | ###TODO: Change Devel::CoverX::Covered to expose this dir properly | 
| 607 |  |  |  |  |  |  | ###and get it from there. | 
| 608 | 0 |  |  |  |  |  | my $dirDb = "covered"; | 
| 609 | 0 | 0 |  |  |  |  | -d $dirDb or return( {} ); | 
| 610 |  |  |  |  |  |  |  | 
| 611 | 0 |  |  |  |  |  | my $db = Devel::CoverX::Covered::Db->new(); | 
| 612 | 0 |  |  |  |  |  | my $fileRelative = file($file)->relative( $self->dirProject ); | 
| 613 | 0 |  |  |  |  |  | my %hSubQuality; | 
| 614 | 0 |  |  |  |  |  | for my $raSubQuality ( $db->covered_subs($fileRelative) ) { | 
| 615 | 0 |  |  |  |  |  | my ($sub, $quality) = @$raSubQuality; | 
| 616 | 0 |  |  |  |  |  | $hSubQuality{$sub} += $quality; | 
| 617 |  |  |  |  |  |  | } | 
| 618 |  |  |  |  |  |  |  | 
| 619 | 0 |  |  |  |  |  | return(\%hSubQuality); | 
| 620 |  |  |  |  |  |  | } | 
| 621 |  |  |  |  |  |  |  | 
| 622 |  |  |  |  |  |  |  | 
| 623 |  |  |  |  |  |  |  | 
| 624 |  |  |  |  |  |  |  | 
| 625 |  |  |  |  |  |  |  | 
| 626 |  |  |  |  |  |  | =head2 raFileTestOther(file => $fileSource, [sub => $sub]) | 
| 627 |  |  |  |  |  |  |  | 
| 628 |  |  |  |  |  |  | Return array ref with file names of files related to $file and | 
| 629 |  |  |  |  |  |  | possibly $sub, i.e. the "other" files related $file. | 
| 630 |  |  |  |  |  |  |  | 
| 631 |  |  |  |  |  |  | If $file is a source file, return test files, and vice verca. | 
| 632 |  |  |  |  |  |  |  | 
| 633 |  |  |  |  |  |  | $sub is only ever active when $fileSource is a source file. | 
| 634 |  |  |  |  |  |  |  | 
| 635 |  |  |  |  |  |  | Die if Devel::CoverX::Covered isn't installed. | 
| 636 |  |  |  |  |  |  |  | 
| 637 |  |  |  |  |  |  | =cut | 
| 638 | 0 |  |  | 0 | 1 |  | sub raFileTestOther { | 
| 639 | 0 |  |  |  |  |  | my ($file, $sub) = Devel::PerlySense::Util::aNamedArg(["file", "sub"], @_); | 
| 640 |  |  |  |  |  |  |  | 
| 641 | 0 |  |  |  |  |  | eval { | 
| 642 | 0 |  |  |  |  |  | require Devel::CoverX::Covered; | 
| 643 | 0 |  |  |  |  |  | require Devel::CoverX::Covered::Db; | 
| 644 |  |  |  |  |  |  | }; | 
| 645 | 0 | 0 |  |  |  |  | $@ and die("Devel::CoverX::Covered isn't installed\n"); | 
| 646 |  |  |  |  |  |  |  | 
| 647 |  |  |  |  |  |  | ###TODO: verify there is a cover_db database present | 
| 648 |  |  |  |  |  |  |  | 
| 649 | 0 |  |  |  |  |  | local $CWD = $self->dirProject . ""; | 
| 650 |  |  |  |  |  |  |  | 
| 651 | 0 |  |  |  |  |  | my $db = Devel::CoverX::Covered::Db->new(); | 
| 652 |  |  |  |  |  |  |  | 
| 653 | 0 |  |  |  |  |  | my $method = "source_files_covered_by";                    # Default to test file | 
| 654 | 0 | 0 |  |  |  |  | $file =~ m|\.pm$| and $method = "test_files_covering";     # If a module, it's source | 
| 655 | 0 | 0 |  |  |  |  | $file =~ m|/t/|   and $method = "source_files_covered_by"; # If it's in /t/, it's a test | 
| 656 | 0 | 0 |  |  |  |  | $file =~ m|\.t$|  and $method = "source_files_covered_by"; # If it's a .t file, it's a test | 
| 657 |  |  |  |  |  |  | ### TODO: config with list of lib dirs and list of test dirs | 
| 658 | 0 |  |  |  |  |  | debug("raFileTestOther with method ($method)"); | 
| 659 |  |  |  |  |  |  |  | 
| 660 | 0 |  |  |  |  |  | my $fileRelative = file($file)->relative( $self->dirProject ); | 
| 661 | 0 |  |  |  |  |  | my $raFileTestOther = [ $db->$method($fileRelative, $sub) ]; | 
| 662 |  |  |  |  |  |  |  | 
| 663 | 0 |  |  |  |  |  | return($raFileTestOther); | 
| 664 |  |  |  |  |  |  | } | 
| 665 |  |  |  |  |  |  |  | 
| 666 |  |  |  |  |  |  |  | 
| 667 |  |  |  |  |  |  |  | 
| 668 |  |  |  |  |  |  |  | 
| 669 |  |  |  |  |  |  |  | 
| 670 |  |  |  |  |  |  | =head2 raFileProjectOther(file => $fileSource, [sub => $sub]) | 
| 671 |  |  |  |  |  |  |  | 
| 672 |  |  |  |  |  |  | Return array ref with file names of files corresponding to $file. | 
| 673 |  |  |  |  |  |  |  | 
| 674 |  |  |  |  |  |  | Die if there is no config file. | 
| 675 |  |  |  |  |  |  |  | 
| 676 |  |  |  |  |  |  | =cut | 
| 677 | 0 |  |  | 0 | 1 |  | sub raFileProjectOther { | 
| 678 | 0 |  |  |  |  |  | my ($file, $sub) = Devel::PerlySense::Util::aNamedArg(["file"], @_); | 
| 679 |  |  |  |  |  |  |  | 
| 680 | 0 |  |  |  |  |  | eval { | 
| 681 | 0 |  |  |  |  |  | require File::Corresponding; | 
| 682 | 0 |  |  |  |  |  | require File::Corresponding::Config::Find; | 
| 683 |  |  |  |  |  |  | }; | 
| 684 | 0 | 0 |  |  |  |  | $@ and die("File::Corresponding isn't installed\n"); | 
| 685 |  |  |  |  |  |  |  | 
| 686 |  |  |  |  |  |  |  | 
| 687 |  |  |  |  |  |  | # Work from the project dir, so the rest of the paths will just work out | 
| 688 | 0 |  |  |  |  |  | local $CWD = $self->dirProject . ""; | 
| 689 |  |  |  |  |  |  |  | 
| 690 | 0 | 0 |  |  |  |  | my $fileConfig = File::Corresponding::Config::Find->new( | 
| 691 |  |  |  |  |  |  | preferred_dirs => [ dir(".PerlySenseProject"), dir(".") ], | 
| 692 |  |  |  |  |  |  | )->user_config(".corresponding_file") | 
| 693 |  |  |  |  |  |  | or die("Could not find a '.corresponding_file' config file in either 1) the .PerlySenseProject;  b) the current directory;  c) your home directory. See perldoc File::Corresponding for information on how to create one.\n"); | 
| 694 |  |  |  |  |  |  |  | 
| 695 | 0 |  |  |  |  |  | my $corresponding = File::Corresponding->new(); | 
| 696 | 0 | 0 |  |  |  |  | eval { $corresponding->load_config_file($fileConfig) } | 
|  | 0 |  |  |  |  |  |  | 
| 697 |  |  |  |  |  |  | or die("Could not read config file ($fileConfig): $@\n"); | 
| 698 |  |  |  |  |  |  |  | 
| 699 | 0 |  |  |  |  |  | my $fileRelative = file($file)->relative( $self->dirProject ); | 
| 700 | 0 |  |  |  |  |  | my @aFileProjectOther = uniq( | 
| 701 | 0 |  |  |  |  |  | map { $_->file } | 
| 702 | 0 |  |  |  |  |  | @{$corresponding->corresponding( $fileRelative )} | 
| 703 |  |  |  |  |  |  | ); | 
| 704 |  |  |  |  |  |  |  | 
| 705 | 0 |  |  |  |  |  | return(\@aFileProjectOther); | 
| 706 |  |  |  |  |  |  | } | 
| 707 |  |  |  |  |  |  |  | 
| 708 |  |  |  |  |  |  |  | 
| 709 |  |  |  |  |  |  |  | 
| 710 |  |  |  |  |  |  |  | 
| 711 |  |  |  |  |  |  |  | 
| 712 |  |  |  |  |  |  |  | 
| 713 |  |  |  |  |  |  | 1; | 
| 714 |  |  |  |  |  |  |  | 
| 715 |  |  |  |  |  |  |  | 
| 716 |  |  |  |  |  |  |  | 
| 717 |  |  |  |  |  |  |  | 
| 718 |  |  |  |  |  |  |  | 
| 719 |  |  |  |  |  |  | __END__ | 
| 720 |  |  |  |  |  |  |  | 
| 721 |  |  |  |  |  |  | =encoding utf8 | 
| 722 |  |  |  |  |  |  |  | 
| 723 |  |  |  |  |  |  | =head1 AUTHOR | 
| 724 |  |  |  |  |  |  |  | 
| 725 |  |  |  |  |  |  | Johan Lindström, C<< <johanl[ÄT]DarSerMan.com> >> | 
| 726 |  |  |  |  |  |  |  | 
| 727 |  |  |  |  |  |  | =head1 BUGS | 
| 728 |  |  |  |  |  |  |  | 
| 729 |  |  |  |  |  |  | Please report any bugs or feature requests to | 
| 730 |  |  |  |  |  |  | C<bug-devel-perlysense@rt.cpan.org>, or through the web interface at | 
| 731 |  |  |  |  |  |  | L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Devel-PerlySense>. | 
| 732 |  |  |  |  |  |  | I will be notified, and then you'll automatically be notified of progress on | 
| 733 |  |  |  |  |  |  | your bug as I make changes. | 
| 734 |  |  |  |  |  |  |  | 
| 735 |  |  |  |  |  |  | =head1 ACKNOWLEDGEMENTS | 
| 736 |  |  |  |  |  |  |  | 
| 737 |  |  |  |  |  |  | =head1 COPYRIGHT & LICENSE | 
| 738 |  |  |  |  |  |  |  | 
| 739 |  |  |  |  |  |  | Copyright 2005 Johan Lindström, All Rights Reserved. | 
| 740 |  |  |  |  |  |  |  | 
| 741 |  |  |  |  |  |  | This program is free software; you can redistribute it and/or modify it | 
| 742 |  |  |  |  |  |  | under the same terms as Perl itself. | 
| 743 |  |  |  |  |  |  |  | 
| 744 |  |  |  |  |  |  | =cut |