64
|
21 |
20 |
0 |
$CACHE{$CACHE_KEY} ||= do {
if ($shorthand) {
$backspace = $1 if $shorthand =~ s[^((\.{1,2}/){1,})][];
$backspace = $1 if $shorthand =~ s[^(/+)][] and not $backspace;
($methods) = $1 if $shorthand =~ s/((\.\w+){1,})$//;
$myspace = join('::', map({/_/ ? join('', map({ucfirst lc $_;} split(/_/, $_, 0))) : ucfirst $_;} split(m[(?:::|\-|/)], $shorthand, 0)));
if ($backspace) {
unless ($backspace =~ m[^/$]) {
@class = split(/::/, $namespace, 0);
if ($backspace =~ m[^//$]) {
while (@class > 1) {
pop @class;
};
}
else {
unless ($backspace =~ m[^\./$]) {
my(@backspaces) = $backspace =~ m[\.\./]g;
foreach $_ (@backspaces) {
pop @class unless @class == 1;
};
};
};
};
}
else {
push @class, $namespace;
};
push @class, split(/::/, $myspace, 0) if $myspace;
push @methods, grep(/\w+/, split(/\./, $methods, 0)) if $methods;
};
push @class, $namespace unless @class;
my $class = @class > 1 ? join('::', @class) : $class[0];
my $file = "$class.pm";
$file =~ s[::][/]g;
unless ($INC{$file}) {
my(@matches) = grep(/^$file/i, keys %INC);
if (@matches == 1) {
$class = $matches[0];
$class =~ s[/][::]g;
$class =~ s/\.pm$//;
};
};
$CACHE{$CACHE_KEY} = {'CLASS', $class, 'METHODS', [@methods]}
} |