| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | =head1 NAME | 
| 2 |  |  |  |  |  |  |  | 
| 3 |  |  |  |  |  |  | Devel::PerlySense::Class - A Perl Class | 
| 4 |  |  |  |  |  |  |  | 
| 5 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 6 |  |  |  |  |  |  |  | 
| 7 |  |  |  |  |  |  |  | 
| 8 |  |  |  |  |  |  |  | 
| 9 |  |  |  |  |  |  | =head1 DESCRIPTION | 
| 10 |  |  |  |  |  |  |  | 
| 11 |  |  |  |  |  |  | A Perl Class is a Perl Package with an OO interface. | 
| 12 |  |  |  |  |  |  |  | 
| 13 |  |  |  |  |  |  | =cut | 
| 14 |  |  |  |  |  |  |  | 
| 15 |  |  |  |  |  |  |  | 
| 16 |  |  |  |  |  |  |  | 
| 17 |  |  |  |  |  |  |  | 
| 18 |  |  |  |  |  |  |  | 
| 19 | 63 |  |  | 63 |  | 206 | use strict; | 
|  | 63 |  |  |  |  | 85 |  | 
|  | 63 |  |  |  |  | 1745 |  | 
| 20 | 63 |  |  | 63 |  | 252 | use warnings; | 
|  | 63 |  |  |  |  | 78 |  | 
|  | 63 |  |  |  |  | 1229 |  | 
| 21 | 63 |  |  | 63 |  | 210 | use utf8; | 
|  | 63 |  |  |  |  | 115 |  | 
|  | 63 |  |  |  |  | 250 |  | 
| 22 |  |  |  |  |  |  |  | 
| 23 |  |  |  |  |  |  | package Devel::PerlySense::Class; | 
| 24 |  |  |  |  |  |  |  | 
| 25 |  |  |  |  |  |  |  | 
| 26 |  |  |  |  |  |  |  | 
| 27 |  |  |  |  |  |  |  | 
| 28 |  |  |  |  |  |  |  | 
| 29 | 63 |  |  | 63 |  | 5297 | use Spiffy -Base; | 
|  | 63 |  |  |  |  | 77 |  | 
|  | 63 |  |  |  |  | 263 |  | 
| 30 | 63 |  |  | 63 |  | 110771 | use Carp; | 
|  | 63 |  |  | 63 |  | 87 |  | 
|  | 63 |  |  | 63 |  | 1421 |  | 
|  | 63 |  |  |  |  | 218 |  | 
|  | 63 |  |  |  |  | 69 |  | 
|  | 63 |  |  |  |  | 1212 |  | 
|  | 63 |  |  |  |  | 215 |  | 
|  | 63 |  |  |  |  | 79 |  | 
|  | 63 |  |  |  |  | 3291 |  | 
| 31 | 63 |  |  | 63 |  | 270 | use Data::Dumper; | 
|  | 63 |  |  |  |  | 80 |  | 
|  | 63 |  |  |  |  | 2242 |  | 
| 32 | 63 |  |  | 63 |  | 276 | use File::Basename; | 
|  | 63 |  |  |  |  | 115 |  | 
|  | 63 |  |  |  |  | 3655 |  | 
| 33 | 63 |  |  | 63 |  | 252 | use Path::Class qw/dir file/; | 
|  | 63 |  |  |  |  | 82 |  | 
|  | 63 |  |  |  |  | 2723 |  | 
| 34 | 63 |  |  | 63 |  | 478 | use List::MoreUtils qw/ uniq /; | 
|  | 63 |  |  |  |  | 81 |  | 
|  | 63 |  |  |  |  | 2362 |  | 
| 35 |  |  |  |  |  |  |  | 
| 36 | 63 |  |  | 63 |  | 242 | use Devel::PerlySense; | 
|  | 63 |  |  |  |  | 73 |  | 
|  | 63 |  |  |  |  | 363 |  | 
| 37 | 63 |  |  | 63 |  | 11930 | use Devel::PerlySense::Util; | 
|  | 63 |  |  |  |  | 77 |  | 
|  | 63 |  |  |  |  | 3265 |  | 
| 38 | 63 |  |  | 63 |  | 246 | use Devel::PerlySense::Util::Log; | 
|  | 63 |  |  |  |  | 76 |  | 
|  | 63 |  |  |  |  | 2278 |  | 
| 39 | 63 |  |  | 63 |  | 14025 | use Devel::PerlySense::Document; | 
|  | 63 |  |  |  |  | 108 |  | 
|  | 63 |  |  |  |  | 489 |  | 
| 40 | 63 |  |  | 63 |  | 19926 | use Devel::PerlySense::Document::Api; | 
|  | 63 |  |  |  |  | 99 |  | 
|  | 63 |  |  |  |  | 689 |  | 
| 41 | 63 |  |  | 63 |  | 25223 | use Devel::PerlySense::Document::Meta; | 
|  | 63 |  |  |  |  | 111 |  | 
|  | 63 |  |  |  |  | 349 |  | 
| 42 | 63 |  |  | 63 |  | 15707 | use Devel::PerlySense::Document::Location; | 
|  | 63 |  |  |  |  | 81 |  | 
|  | 63 |  |  |  |  | 428 |  | 
| 43 |  |  |  |  |  |  |  | 
| 44 | 63 |  |  | 63 |  | 20162 | use Devel::TimeThis; | 
|  | 63 |  |  |  |  | 80 |  | 
|  | 63 |  |  |  |  | 112283 |  | 
| 45 |  |  |  |  |  |  |  | 
| 46 |  |  |  |  |  |  |  | 
| 47 |  |  |  |  |  |  |  | 
| 48 |  |  |  |  |  |  |  | 
| 49 |  |  |  |  |  |  |  | 
| 50 |  |  |  |  |  |  | =head1 PROPERTIES | 
| 51 |  |  |  |  |  |  |  | 
| 52 |  |  |  |  |  |  | =head2 oPerlySense | 
| 53 |  |  |  |  |  |  |  | 
| 54 |  |  |  |  |  |  | Devel::PerlySense object. | 
| 55 |  |  |  |  |  |  |  | 
| 56 |  |  |  |  |  |  | Default: set during new() | 
| 57 |  |  |  |  |  |  |  | 
| 58 |  |  |  |  |  |  | =cut | 
| 59 |  |  |  |  |  |  | field "oPerlySense" => undef; | 
| 60 |  |  |  |  |  |  |  | 
| 61 |  |  |  |  |  |  |  | 
| 62 |  |  |  |  |  |  |  | 
| 63 |  |  |  |  |  |  |  | 
| 64 |  |  |  |  |  |  |  | 
| 65 |  |  |  |  |  |  | =head2 name | 
| 66 |  |  |  |  |  |  |  | 
| 67 |  |  |  |  |  |  | The Class name (i.e. the package name) | 
| 68 |  |  |  |  |  |  |  | 
| 69 |  |  |  |  |  |  | Default: "" | 
| 70 |  |  |  |  |  |  |  | 
| 71 |  |  |  |  |  |  | =cut | 
| 72 |  |  |  |  |  |  | field "name" => ""; | 
| 73 |  |  |  |  |  |  |  | 
| 74 |  |  |  |  |  |  |  | 
| 75 |  |  |  |  |  |  |  | 
| 76 |  |  |  |  |  |  |  | 
| 77 |  |  |  |  |  |  |  | 
| 78 |  |  |  |  |  |  | =head2 raDocument | 
| 79 |  |  |  |  |  |  |  | 
| 80 |  |  |  |  |  |  | Array ref with PerlySense::Document objects that define this class. | 
| 81 |  |  |  |  |  |  |  | 
| 82 |  |  |  |  |  |  | Default: [] | 
| 83 |  |  |  |  |  |  |  | 
| 84 |  |  |  |  |  |  | =cut | 
| 85 |  |  |  |  |  |  | field "raDocument" => []; | 
| 86 |  |  |  |  |  |  |  | 
| 87 |  |  |  |  |  |  |  | 
| 88 |  |  |  |  |  |  |  | 
| 89 |  |  |  |  |  |  |  | 
| 90 |  |  |  |  |  |  |  | 
| 91 |  |  |  |  |  |  | =head2 rhClassBase | 
| 92 |  |  |  |  |  |  |  | 
| 93 |  |  |  |  |  |  | Hash ref with (keys: base class names; values: base class | 
| 94 |  |  |  |  |  |  | PerlySense::Class objects). | 
| 95 |  |  |  |  |  |  |  | 
| 96 |  |  |  |  |  |  | Default: {} | 
| 97 |  |  |  |  |  |  |  | 
| 98 |  |  |  |  |  |  | =cut | 
| 99 |  |  |  |  |  |  | ###TODO: Make this lazy, populate on first request, so we don't have | 
| 100 |  |  |  |  |  |  | ###to go all the way up all the time! There are enough objects in | 
| 101 |  |  |  |  |  |  | ###memory as it is (this makes all subclasses eagerly find all ther | 
| 102 |  |  |  |  |  |  | ###base classes...) | 
| 103 |  |  |  |  |  |  | field "rhClassBase" => {}; | 
| 104 |  |  |  |  |  |  |  | 
| 105 |  |  |  |  |  |  |  | 
| 106 |  |  |  |  |  |  |  | 
| 107 |  |  |  |  |  |  |  | 
| 108 |  |  |  |  |  |  |  | 
| 109 |  |  |  |  |  |  | =head1 API METHODS | 
| 110 |  |  |  |  |  |  |  | 
| 111 |  |  |  |  |  |  | =head2 new(oPerlySense, name, raDocument, rhClassSeen => {}) | 
| 112 |  |  |  |  |  |  |  | 
| 113 |  |  |  |  |  |  | Create new PerlySense::Class object. Give it $name and associate it | 
| 114 |  |  |  |  |  |  | with $oPerlySense. | 
| 115 |  |  |  |  |  |  |  | 
| 116 |  |  |  |  |  |  | $rhClassSeen is used to keep track of seen base classes in case we | 
| 117 |  |  |  |  |  |  | encounter circular deps. | 
| 118 |  |  |  |  |  |  |  | 
| 119 |  |  |  |  |  |  | =cut | 
| 120 | 28 |  |  | 28 | 1 | 65 | sub new { | 
| 121 | 28 |  |  |  |  | 143 | my ($oPerlySense, $name, $raDocument) = Devel::PerlySense::Util::aNamedArg(["oPerlySense", "name", "raDocument"], @_); | 
| 122 | 27 |  |  |  |  | 109 | my $rhClassSeen = {@_}->{rhClassSeen}; | 
| 123 |  |  |  |  |  |  |  | 
| 124 | 27 |  |  |  |  | 134 | $self = bless {}, $self;    #Create the object. It looks weird because of Spiffy | 
| 125 | 27 |  |  |  |  | 739 | $self->oPerlySense($oPerlySense); | 
| 126 | 27 |  |  |  |  | 851 | $self->name($name); | 
| 127 | 27 |  |  |  |  | 1064 | $self->raDocument($raDocument); | 
| 128 |  |  |  |  |  |  |  | 
| 129 | 27 |  | 100 |  |  | 365 | $rhClassSeen ||= { $name => $self }; | 
| 130 | 27 |  |  |  |  | 106 | $self->findBaseClasses(rhClassSeen => $rhClassSeen); | 
| 131 |  |  |  |  |  |  |  | 
| 132 | 27 |  |  |  |  | 71 | return($self); | 
| 133 |  |  |  |  |  |  | } | 
| 134 |  |  |  |  |  |  |  | 
| 135 |  |  |  |  |  |  |  | 
| 136 |  |  |  |  |  |  |  | 
| 137 |  |  |  |  |  |  |  | 
| 138 |  |  |  |  |  |  |  | 
| 139 |  |  |  |  |  |  | =head2 newFromFileAt(oPerlySense => $oPerlySense, file => $file, row => $row, col => $col) | 
| 140 |  |  |  |  |  |  |  | 
| 141 |  |  |  |  |  |  | Create new PerlySense::Class object given the class found at $row, | 
| 142 |  |  |  |  |  |  | $col in $file. | 
| 143 |  |  |  |  |  |  |  | 
| 144 |  |  |  |  |  |  | If there was no package started yet at $row, $col, but there is one | 
| 145 |  |  |  |  |  |  | later in the file, use the first one instead (this is when you're at | 
| 146 |  |  |  |  |  |  | the top of the file and the package statement didn't happen yet). | 
| 147 |  |  |  |  |  |  |  | 
| 148 |  |  |  |  |  |  | Return new object, or undef if no class was found, or die if the file | 
| 149 |  |  |  |  |  |  | doesn't exist. | 
| 150 |  |  |  |  |  |  |  | 
| 151 |  |  |  |  |  |  | =cut | 
| 152 | 8 |  |  | 8 | 1 | 16 | sub newFromFileAt { | 
| 153 | 8 |  |  |  |  | 45 | my ($oPerlySense, $file, $row, $col) = Devel::PerlySense::Util::aNamedArg(["oPerlySense", "file", "row", "col"], @_); | 
| 154 |  |  |  |  |  |  |  | 
| 155 | 8 |  |  |  |  | 43 | my $oDocument = $oPerlySense->oDocumentParseFile($file); | 
| 156 | 7 |  |  |  |  | 31 | my $package = $oDocument->packageAt(row => $row); | 
| 157 |  |  |  |  |  |  |  | 
| 158 | 7 | 100 |  |  |  | 202 | if($package eq "main") { | 
| 159 | 2 | 50 |  |  |  | 9 | $package = ($oDocument->aNamePackage)[0] or return undef; | 
| 160 |  |  |  |  |  |  | } | 
| 161 |  |  |  |  |  |  |  | 
| 162 | 7 |  |  |  |  | 121 | my $class = Devel::PerlySense::Class->new( | 
| 163 |  |  |  |  |  |  | oPerlySense => $oPerlySense, | 
| 164 |  |  |  |  |  |  | name => $package, | 
| 165 |  |  |  |  |  |  | raDocument => [ $oDocument ], | 
| 166 |  |  |  |  |  |  | ); | 
| 167 |  |  |  |  |  |  |  | 
| 168 | 7 |  |  |  |  | 51 | return($class); | 
| 169 |  |  |  |  |  |  | } | 
| 170 |  |  |  |  |  |  |  | 
| 171 |  |  |  |  |  |  |  | 
| 172 |  |  |  |  |  |  |  | 
| 173 |  |  |  |  |  |  |  | 
| 174 |  |  |  |  |  |  |  | 
| 175 |  |  |  |  |  |  | =head2 newFromName(oPerlySense, name, dirOrigin, rhClassSeen) | 
| 176 |  |  |  |  |  |  |  | 
| 177 |  |  |  |  |  |  | Create new PerlySense::Class object given the class $name. | 
| 178 |  |  |  |  |  |  |  | 
| 179 |  |  |  |  |  |  | Look for the module file starting at $dirOrigin. | 
| 180 |  |  |  |  |  |  |  | 
| 181 |  |  |  |  |  |  | Return new object, or undef if no class was found with that $name. | 
| 182 |  |  |  |  |  |  |  | 
| 183 |  |  |  |  |  |  | =cut | 
| 184 | 15 |  |  | 15 | 1 | 1259 | sub newFromName { | 
| 185 | 15 |  |  |  |  | 65 | my ($oPerlySense, $name, $dirOrigin, $rhClassSeen) = Devel::PerlySense::Util::aNamedArg(["oPerlySense", "name", "dirOrigin", "rhClassSeen"], @_); | 
| 186 |  |  |  |  |  |  |  | 
| 187 | 15 | 50 |  |  |  | 76 | my $oDocument = $oPerlySense->oDocumentFindModule( | 
| 188 |  |  |  |  |  |  | nameModule => $name, | 
| 189 |  |  |  |  |  |  | dirOrigin => $dirOrigin, | 
| 190 |  |  |  |  |  |  | ) or return undef; | 
| 191 |  |  |  |  |  |  |  | 
| 192 | 15 |  |  |  |  | 170 | my $class = Devel::PerlySense::Class->new( | 
| 193 |  |  |  |  |  |  | rhClassSeen => $rhClassSeen, | 
| 194 |  |  |  |  |  |  | oPerlySense => $oPerlySense, | 
| 195 |  |  |  |  |  |  | name => $name, | 
| 196 |  |  |  |  |  |  | raDocument => [ $oDocument ], | 
| 197 |  |  |  |  |  |  | ); | 
| 198 |  |  |  |  |  |  |  | 
| 199 | 15 |  |  |  |  | 80 | return($class); | 
| 200 |  |  |  |  |  |  | } | 
| 201 |  |  |  |  |  |  |  | 
| 202 |  |  |  |  |  |  |  | 
| 203 |  |  |  |  |  |  |  | 
| 204 |  |  |  |  |  |  |  | 
| 205 |  |  |  |  |  |  |  | 
| 206 |  |  |  |  |  |  | =head2 findBaseClasses(rhClassSeen) | 
| 207 |  |  |  |  |  |  |  | 
| 208 |  |  |  |  |  |  | Find the base classes of this class and set (replace) rBaseClass with | 
| 209 |  |  |  |  |  |  | newly created Class objects. | 
| 210 |  |  |  |  |  |  |  | 
| 211 |  |  |  |  |  |  | Reuse any class names and objects in $rhClassSeen (keys: class names; | 
| 212 |  |  |  |  |  |  | values: Class objects), i.e. don't follow them upwards, they have | 
| 213 |  |  |  |  |  |  | already been taken care of. | 
| 214 |  |  |  |  |  |  |  | 
| 215 |  |  |  |  |  |  | =cut | 
| 216 | 27 |  |  | 27 | 1 | 32 | sub findBaseClasses { | 
| 217 | 27 |  |  |  |  | 82 | my ($rhClassSeen) = Devel::PerlySense::Util::aNamedArg(["rhClassSeen"], @_); | 
| 218 |  |  |  |  |  |  |  | 
| 219 | 27 |  |  |  |  | 63 | my $rhClassBase = {}; | 
| 220 |  |  |  |  |  |  |  | 
| 221 | 27 |  |  |  |  | 642 | debug("Checking class (" . $self->name . ") for inheritance\n"); | 
| 222 |  |  |  |  |  |  |  | 
| 223 |  |  |  |  |  |  | ###TODO: protect against infinite inheritance loops | 
| 224 | 27 |  |  |  |  | 41 | for my $oDocument (@{$self->raDocument}) { | 
|  | 27 |  |  |  |  | 784 |  | 
| 225 | 26 |  |  |  |  | 213 | for my $classNameBase ($oDocument->aNameBase) { | 
| 226 | 18 |  |  |  |  | 427 | debug("  Base for (" . $self->name . ") is ($classNameBase)\n"); | 
| 227 | 18 | 50 | 66 |  |  | 433 | my $classBase = | 
| 228 |  |  |  |  |  |  | $rhClassSeen->{$classNameBase} || | 
| 229 |  |  |  |  |  |  | ref($self)->newFromName( | 
| 230 |  |  |  |  |  |  | oPerlySense => $self->oPerlySense, | 
| 231 |  |  |  |  |  |  | rhClassSeen => $rhClassSeen, | 
| 232 |  |  |  |  |  |  | name => $classNameBase, | 
| 233 |  |  |  |  |  |  | dirOrigin => dirname($oDocument->file), | 
| 234 |  |  |  |  |  |  | ) or debug("WARN: Could not find parent ($classNameBase)\n"), next;  #Don't stop if we can't find the base class. Maybe warn? | 
| 235 |  |  |  |  |  |  |  | 
| 236 | 18 |  |  |  |  | 48 | $rhClassSeen->{$classNameBase} = $classBase; | 
| 237 |  |  |  |  |  |  |  | 
| 238 | 18 |  |  |  |  | 84 | $rhClassBase->{$classNameBase} = $classBase; | 
| 239 |  |  |  |  |  |  | } | 
| 240 |  |  |  |  |  |  | } | 
| 241 |  |  |  |  |  |  |  | 
| 242 | 27 |  |  |  |  | 652 | $self->rhClassBase($rhClassBase); | 
| 243 |  |  |  |  |  |  |  | 
| 244 | 27 |  |  |  |  | 173 | return 1; | 
| 245 |  |  |  |  |  |  | } | 
| 246 |  |  |  |  |  |  |  | 
| 247 |  |  |  |  |  |  |  | 
| 248 |  |  |  |  |  |  |  | 
| 249 |  |  |  |  |  |  |  | 
| 250 |  |  |  |  |  |  |  | 
| 251 |  |  |  |  |  |  | =head2 rhClassSub() | 
| 252 |  |  |  |  |  |  |  | 
| 253 |  |  |  |  |  |  | Find the sub classes of this class and return a hash ref with (keys: | 
| 254 |  |  |  |  |  |  | Class names; values: Class objects). | 
| 255 |  |  |  |  |  |  |  | 
| 256 |  |  |  |  |  |  | Look for subclasses in the directory of this Class, and below. | 
| 257 |  |  |  |  |  |  |  | 
| 258 |  |  |  |  |  |  | (In the future, look in all of the current project.) | 
| 259 |  |  |  |  |  |  |  | 
| 260 |  |  |  |  |  |  | (this is a horribly inefficient way of finding subclasses. When there | 
| 261 |  |  |  |  |  |  | is Project with metadata, use that instead of looking everywhere). | 
| 262 |  |  |  |  |  |  |  | 
| 263 |  |  |  |  |  |  | =cut | 
| 264 | 1 |  |  | 1 | 1 | 2 | sub rhClassSub { | 
| 265 |  |  |  |  |  |  |  | 
| 266 | 1 | 50 |  |  |  | 26 | my $oDocument = $self->raDocument->[0] or return {}; | 
| 267 | 1 |  |  |  |  | 29 | my $fileClass = $oDocument->file; | 
| 268 | 1 |  |  |  |  | 62 | my $dirClass = dir( dirname($fileClass) )->absolute; | 
| 269 |  |  |  |  |  |  |  | 
| 270 | 1 |  |  |  |  | 396 | my $nameClass = $self->name; | 
| 271 |  |  |  |  |  |  | my @aDocumentCandidate = | 
| 272 |  |  |  |  |  |  | $self->oPerlySense->aDocumentGrepInDir( | 
| 273 |  |  |  |  |  |  | dir => $dirClass, | 
| 274 | 17 |  |  | 17 |  | 23 | rsGrepFile => sub { shift ne $fileClass }, | 
| 275 | 17 |  |  | 17 |  | 70 | rsGrepDocument => sub { shift->hasBaseClass($nameClass) }, | 
| 276 | 1 | 50 |  |  |  | 27 | ) or return {}; | 
| 277 |  |  |  |  |  |  |  | 
| 278 |  |  |  |  |  |  | ###TODO: can any of this be pushed down into the document/meta | 
| 279 |  |  |  |  |  |  | ###class? | 
| 280 | 1 |  |  |  |  | 7 | my $rhPackageDocument = {}; | 
| 281 | 1 |  |  |  |  | 2 | for my $oDocumentCandidate (@aDocumentCandidate) { | 
| 282 | 4 |  |  |  |  | 10 | for my $package ($oDocumentCandidate->aNamePackage) { | 
| 283 | 4 |  | 50 |  |  | 117 | $rhPackageDocument->{$package} ||= []; | 
| 284 | 4 |  |  |  |  | 3 | push(@{$rhPackageDocument->{$package}}, $oDocumentCandidate); | 
|  | 4 |  |  |  |  | 13 |  | 
| 285 |  |  |  |  |  |  | } | 
| 286 |  |  |  |  |  |  | } | 
| 287 |  |  |  |  |  |  |  | 
| 288 | 4 |  |  |  |  | 6 | my $rhClassSub = { | 
| 289 |  |  |  |  |  |  | map { | 
| 290 | 1 |  |  |  |  | 5 | my $namePackage = $_; | 
| 291 |  |  |  |  |  |  |  | 
| 292 | 4 |  |  |  |  | 100 | $_ => ref($self)->new( | 
| 293 |  |  |  |  |  |  | oPerlySense => $self->oPerlySense, | 
| 294 |  |  |  |  |  |  | name => $namePackage, | 
| 295 |  |  |  |  |  |  | raDocument => $rhPackageDocument->{$namePackage}, | 
| 296 |  |  |  |  |  |  | ); | 
| 297 |  |  |  |  |  |  | } | 
| 298 |  |  |  |  |  |  | keys %$rhPackageDocument | 
| 299 |  |  |  |  |  |  | }; | 
| 300 |  |  |  |  |  |  |  | 
| 301 | 1 |  |  |  |  | 17 | return $rhClassSub; | 
| 302 |  |  |  |  |  |  | } | 
| 303 |  |  |  |  |  |  |  | 
| 304 |  |  |  |  |  |  |  | 
| 305 |  |  |  |  |  |  |  | 
| 306 |  |  |  |  |  |  |  | 
| 307 |  |  |  |  |  |  |  | 
| 308 |  |  |  |  |  |  | =head2 rhDirNameClassInNeighbourhood() | 
| 309 |  |  |  |  |  |  |  | 
| 310 |  |  |  |  |  |  | Find the classes in the neighbourhood of this class and return a hash | 
| 311 |  |  |  |  |  |  | ref with (keys: up, current, down; values: array refs with (Package names). | 
| 312 |  |  |  |  |  |  |  | 
| 313 |  |  |  |  |  |  | =cut | 
| 314 | 12 |  |  | 12 | 0 | 21 | sub raClassInDirs { | 
| 315 | 12 |  |  |  |  | 19 | my ($raDir) = @_; | 
| 316 |  |  |  |  |  |  |  | 
| 317 | 12 |  |  |  |  | 13 | my @aNameClass; | 
| 318 | 12 |  |  |  |  | 27 | for my $dir (@$raDir) { | 
| 319 | 12 |  |  |  |  | 36 | push(@aNameClass, $self->aNameClassInDir(dir => $dir)); | 
| 320 |  |  |  |  |  |  | } | 
| 321 |  |  |  |  |  |  |  | 
| 322 | 12 |  |  |  |  | 210 | return [ sort( uniq(@aNameClass) ) ]; | 
| 323 |  |  |  |  |  |  | } | 
| 324 | 4 |  |  | 4 | 1 | 8 | sub rhDirNameClassInNeighbourhood { | 
| 325 |  |  |  |  |  |  |  | 
| 326 | 4 |  |  |  |  | 145 | my $dir = dir(dirname( $self->raDocument->[0]->file )); | 
| 327 | 4 |  |  |  |  | 656 | my $raDir = [ $dir ]; | 
| 328 | 4 |  |  |  |  | 19 | my $raDirUp = [ $dir->parent ]; | 
| 329 |  |  |  |  |  |  |  | 
| 330 | 4 |  |  |  |  | 682 | my $nameClassLast = (split(/::/, $self->name))[-1]; | 
| 331 | 4 |  |  |  |  | 43 | my $raDirDown = [ dir($dir, $nameClassLast) ]; | 
| 332 |  |  |  |  |  |  |  | 
| 333 |  |  |  |  |  |  | return({ | 
| 334 | 4 |  |  |  |  | 190 | up      => $self->raClassInDirs($raDirUp), | 
| 335 |  |  |  |  |  |  | current => $self->raClassInDirs($raDir), | 
| 336 |  |  |  |  |  |  | down    => $self->raClassInDirs($raDirDown), | 
| 337 |  |  |  |  |  |  | }); | 
| 338 |  |  |  |  |  |  | } | 
| 339 |  |  |  |  |  |  |  | 
| 340 |  |  |  |  |  |  |  | 
| 341 |  |  |  |  |  |  |  | 
| 342 |  |  |  |  |  |  |  | 
| 343 |  |  |  |  |  |  |  | 
| 344 |  |  |  |  |  |  | =head2 aNameClassInDir(dir => $dir) | 
| 345 |  |  |  |  |  |  |  | 
| 346 |  |  |  |  |  |  | Find the classes names in the .pm files in $dir and return a list of | 
| 347 |  |  |  |  |  |  | Class names. | 
| 348 |  |  |  |  |  |  |  | 
| 349 |  |  |  |  |  |  | =cut | 
| 350 | 13 |  |  | 13 | 1 | 17 | sub aNameClassInDir { | 
| 351 | 13 |  |  |  |  | 87 | my ($dir) = Devel::PerlySense::Util::aNamedArg(["dir"], @_); | 
| 352 |  |  |  |  |  |  |  | 
| 353 | 50 |  |  |  |  | 258908 | my @aNameClass = | 
| 354 |  |  |  |  |  |  | map { | 
| 355 | 13 |  |  |  |  | 241 | my $oDocument = Devel::PerlySense::Document->new( | 
| 356 |  |  |  |  |  |  | oPerlySense => $self->oPerlySense, | 
| 357 |  |  |  |  |  |  | ); | 
| 358 | 50 | 50 |  |  |  | 186 | $oDocument->parse(file => $_) ? $oDocument->aNamePackage : (); | 
| 359 |  |  |  |  |  |  | } | 
| 360 |  |  |  |  |  |  | glob("$dir/*.pm"); | 
| 361 |  |  |  |  |  |  |  | 
| 362 | 13 |  |  |  |  | 116806 | return sort( uniq( @aNameClass ) ); | 
| 363 |  |  |  |  |  |  | } | 
| 364 |  |  |  |  |  |  |  | 
| 365 |  |  |  |  |  |  |  | 
| 366 |  |  |  |  |  |  |  | 
| 367 |  |  |  |  |  |  |  | 
| 368 |  |  |  |  |  |  |  | 
| 369 |  |  |  |  |  |  | =head2 aNameModuleUse() | 
| 370 |  |  |  |  |  |  |  | 
| 371 |  |  |  |  |  |  | Return array with the names of the "use MODULE" modules in the Class. | 
| 372 |  |  |  |  |  |  |  | 
| 373 |  |  |  |  |  |  | =cut | 
| 374 | 3 |  |  | 3 | 1 | 6 | sub aNameModuleUse { | 
| 375 | 3 |  |  |  |  | 6 | return sort( uniq( map { $_->aNameModuleUse } @{$self->raDocument} ) ); | 
|  | 3 |  |  |  |  | 34 |  | 
|  | 3 |  |  |  |  | 75 |  | 
| 376 |  |  |  |  |  |  | } | 
| 377 |  |  |  |  |  |  |  | 
| 378 |  |  |  |  |  |  |  | 
| 379 |  |  |  |  |  |  |  | 
| 380 |  |  |  |  |  |  |  | 
| 381 |  |  |  |  |  |  |  | 
| 382 |  |  |  |  |  |  | =head2 aBookmarkMatchResult() | 
| 383 |  |  |  |  |  |  |  | 
| 384 |  |  |  |  |  |  | Return array of Bookmark::MatchResult objects that matches the current | 
| 385 |  |  |  |  |  |  | source. | 
| 386 |  |  |  |  |  |  |  | 
| 387 |  |  |  |  |  |  | =cut | 
| 388 | 3 |  |  | 3 | 1 | 4 | sub aBookmarkMatchResult { | 
| 389 | 3 |  |  |  |  | 124 | my $file = $self->raDocument->[0]->file; | 
| 390 | 3 |  |  |  |  | 180 | return $self->oPerlySense->oBookmarkConfig->aMatchResult(file => $file); | 
| 391 |  |  |  |  |  |  | } | 
| 392 |  |  |  |  |  |  |  | 
| 393 |  |  |  |  |  |  |  | 
| 394 |  |  |  |  |  |  |  | 
| 395 |  |  |  |  |  |  |  | 
| 396 |  |  |  |  |  |  |  | 
| 397 |  |  |  |  |  |  | =head2 dirModule() | 
| 398 |  |  |  |  |  |  |  | 
| 399 |  |  |  |  |  |  | Return the base dir for this class, i.e. the dir in which the main .pm | 
| 400 |  |  |  |  |  |  | file is in. | 
| 401 |  |  |  |  |  |  |  | 
| 402 |  |  |  |  |  |  | =cut | 
| 403 | 0 |  |  | 0 | 1 | 0 | sub dirModule { | 
| 404 | 0 |  |  |  |  | 0 | my $file = $self->raDocument->[0]->file; | 
| 405 | 0 |  |  |  |  | 0 | return file($file)->absolute->dir . ""; | 
| 406 |  |  |  |  |  |  | } | 
| 407 |  |  |  |  |  |  |  | 
| 408 |  |  |  |  |  |  |  | 
| 409 |  |  |  |  |  |  |  | 
| 410 |  |  |  |  |  |  |  | 
| 411 |  |  |  |  |  |  |  | 
| 412 |  |  |  |  |  |  | =head2 oLocationMethodDoc(method => $method) | 
| 413 |  |  |  |  |  |  |  | 
| 414 |  |  |  |  |  |  | Find the docs for the $method name and return a Location object | 
| 415 |  |  |  |  |  |  | similar to PerlySense->oLocationMethodDocFromDocument, or undef if no | 
| 416 |  |  |  |  |  |  | doc could be found. | 
| 417 |  |  |  |  |  |  |  | 
| 418 |  |  |  |  |  |  | Die on errors. | 
| 419 |  |  |  |  |  |  |  | 
| 420 |  |  |  |  |  |  | =cut | 
| 421 | 3 |  |  | 3 | 1 | 5 | sub oLocationMethodDoc { | 
| 422 | 3 |  |  |  |  | 11 | my ($method) = Devel::PerlySense::Util::aNamedArg(["method"], @_); | 
| 423 | 3 | 50 |  |  |  | 81 | my $oDocument = $self->raDocument->[0] or return undef; | 
| 424 | 3 |  |  |  |  | 88 | return $self->oPerlySense->oLocationMethodDocFromDocument($oDocument, $method); | 
| 425 |  |  |  |  |  |  | } | 
| 426 |  |  |  |  |  |  |  | 
| 427 |  |  |  |  |  |  |  | 
| 428 |  |  |  |  |  |  |  | 
| 429 |  |  |  |  |  |  |  | 
| 430 |  |  |  |  |  |  |  | 
| 431 |  |  |  |  |  |  | =head2 oLocationMethodGoTo(method => $method) | 
| 432 |  |  |  |  |  |  |  | 
| 433 |  |  |  |  |  |  | Find the declaration for the $method name and return a Location object | 
| 434 |  |  |  |  |  |  | similar to PerlySense->oLocationSubDefinitionFromDocument, or undef if no | 
| 435 |  |  |  |  |  |  | declaration could be found. | 
| 436 |  |  |  |  |  |  |  | 
| 437 |  |  |  |  |  |  | Die on errors. | 
| 438 |  |  |  |  |  |  |  | 
| 439 |  |  |  |  |  |  | =cut | 
| 440 | 2 |  |  | 2 | 1 | 2 | sub oLocationMethodGoTo { | 
| 441 | 2 |  |  |  |  | 9 | my ($method) = Devel::PerlySense::Util::aNamedArg(["method"], @_); | 
| 442 | 2 | 50 |  |  |  | 55 | my $oDocument = $self->raDocument->[0] or return undef; | 
| 443 | 2 |  |  |  |  | 58 | return $self->oPerlySense->oLocationMethodDefinitionFromDocument( | 
| 444 |  |  |  |  |  |  | nameClass => $self->name, | 
| 445 |  |  |  |  |  |  | nameMethod => $method, | 
| 446 |  |  |  |  |  |  | oDocument => $oDocument, | 
| 447 |  |  |  |  |  |  | ); | 
| 448 |  |  |  |  |  |  | } | 
| 449 |  |  |  |  |  |  |  | 
| 450 |  |  |  |  |  |  |  | 
| 451 |  |  |  |  |  |  |  | 
| 452 |  |  |  |  |  |  |  | 
| 453 |  |  |  |  |  |  |  | 
| 454 |  |  |  |  |  |  | =head2 oLocationSubAt(row => $row, col => $col) | 
| 455 |  |  |  |  |  |  |  | 
| 456 |  |  |  |  |  |  | Return a Devel::PerlySense::Document::Location object with the | 
| 457 |  |  |  |  |  |  | location of the sub definition at $row/$col, or undef if it row/col | 
| 458 |  |  |  |  |  |  | isn't inside a sub definition. | 
| 459 |  |  |  |  |  |  |  | 
| 460 |  |  |  |  |  |  | Die on errors. | 
| 461 |  |  |  |  |  |  |  | 
| 462 |  |  |  |  |  |  | =cut | 
| 463 | 0 |  |  | 0 | 1 |  | sub oLocationSubAt { | 
| 464 | 0 |  |  |  |  |  | my ($row, $col) = Devel::PerlySense::Util::aNamedArg(["row", "col"], @_); | 
| 465 | 0 | 0 |  |  |  |  | my $oDocument = $self->raDocument->[0] or return undef; | 
| 466 | 0 |  |  |  |  |  | return $oDocument->oLocationSubAt(row => $row, col => $col); | 
| 467 |  |  |  |  |  |  | } | 
| 468 |  |  |  |  |  |  |  | 
| 469 |  |  |  |  |  |  |  | 
| 470 |  |  |  |  |  |  |  | 
| 471 |  |  |  |  |  |  |  | 
| 472 |  |  |  |  |  |  |  | 
| 473 |  |  |  |  |  |  | =head2 oLocationSub(name => $name) | 
| 474 |  |  |  |  |  |  |  | 
| 475 |  |  |  |  |  |  | Return a Devel::PerlySense::Document::Location object with the | 
| 476 |  |  |  |  |  |  | location of the sub declaration called $name, or undef if it wasn't | 
| 477 |  |  |  |  |  |  | found. | 
| 478 |  |  |  |  |  |  |  | 
| 479 |  |  |  |  |  |  | Die on errors. | 
| 480 |  |  |  |  |  |  |  | 
| 481 |  |  |  |  |  |  | =cut | 
| 482 | 0 |  |  | 0 | 1 |  | sub oLocationSub { | 
| 483 | 0 |  |  |  |  |  | my ($name) = Devel::PerlySense::Util::aNamedArg(["name"], @_); | 
| 484 | 0 | 0 |  |  |  |  | my $oDocument = $self->raDocument->[0] or return undef; | 
| 485 | 0 |  |  |  |  |  | return $oDocument->oLocationSub(name => $name, package => $self->name); | 
| 486 |  |  |  |  |  |  | } | 
| 487 |  |  |  |  |  |  |  | 
| 488 |  |  |  |  |  |  |  | 
| 489 |  |  |  |  |  |  |  | 
| 490 |  |  |  |  |  |  |  | 
| 491 |  |  |  |  |  |  |  | 
| 492 |  |  |  |  |  |  | 1; | 
| 493 |  |  |  |  |  |  |  | 
| 494 |  |  |  |  |  |  |  | 
| 495 |  |  |  |  |  |  |  | 
| 496 |  |  |  |  |  |  |  | 
| 497 |  |  |  |  |  |  |  | 
| 498 |  |  |  |  |  |  | __END__ | 
| 499 |  |  |  |  |  |  |  | 
| 500 |  |  |  |  |  |  | =encoding utf8 | 
| 501 |  |  |  |  |  |  |  | 
| 502 |  |  |  |  |  |  | =head1 AUTHOR | 
| 503 |  |  |  |  |  |  |  | 
| 504 |  |  |  |  |  |  | Johan Lindström, C<< <johanl[ÄT]DarSerMan.com> >> | 
| 505 |  |  |  |  |  |  |  | 
| 506 |  |  |  |  |  |  | =head1 BUGS | 
| 507 |  |  |  |  |  |  |  | 
| 508 |  |  |  |  |  |  | Please report any bugs or feature requests to | 
| 509 |  |  |  |  |  |  | C<bug-devel-perlysense@rt.cpan.org>, or through the web interface at | 
| 510 |  |  |  |  |  |  | L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Devel-PerlySense>. | 
| 511 |  |  |  |  |  |  | I will be notified, and then you'll automatically be notified of progress on | 
| 512 |  |  |  |  |  |  | your bug as I make changes. | 
| 513 |  |  |  |  |  |  |  | 
| 514 |  |  |  |  |  |  | =head1 ACKNOWLEDGEMENTS | 
| 515 |  |  |  |  |  |  |  | 
| 516 |  |  |  |  |  |  | =head1 COPYRIGHT & LICENSE | 
| 517 |  |  |  |  |  |  |  | 
| 518 |  |  |  |  |  |  | Copyright 2005 Johan Lindström, All Rights Reserved. | 
| 519 |  |  |  |  |  |  |  | 
| 520 |  |  |  |  |  |  | This program is free software; you can redistribute it and/or modify it | 
| 521 |  |  |  |  |  |  | under the same terms as Perl itself. | 
| 522 |  |  |  |  |  |  |  | 
| 523 |  |  |  |  |  |  | =cut |