view release on metacpan or  search on metacpan

lib/Developer/Dashboard/CLI/OpenFile.pm  view on Meta::CPAN

# _unique_matches(@matches)
# Deduplicates resolved open-file matches while preserving their original order.
# Input: list of matched file path strings.
# Output: ordered list of unique file path strings.
sub _unique_matches {
    my (@matches) = @_;
    my %seen;
    return grep { defined && $_ ne '' && !$seen{$_}++ } @matches;
}

# _ordered_scope_matches(%args)
# Orders recursive scope-search matches so exact helper/script names sort before broader substring matches.
# Input: pattern array reference plus discovered file path array reference.
# Output: ordered unique file path strings ranked by basename/stem relevance and original discovery order.
sub _ordered_scope_matches {
    my (%args) = @_;
    my @patterns = @{ $args{patterns} || [] };
    my @entries  = @{ $args{entries} || [] };
    @entries = map { { file => $_, match_path => $_ } } _unique_matches( @{ $args{files} || [] } )
      if !@entries;

    my @ranked;
    for my $index ( 0 .. $#entries ) {
        push @ranked, {
            file  => $entries[$index]{file},
            rank  => _scope_match_rank(
                file      => $entries[$index]{file},
                match_path => $entries[$index]{match_path},
                patterns => \@patterns,
            ),
            index => $index,
        };
    }

    return map { $_->{file} }
      sort {
             $a->{rank}  <=> $b->{rank}
          || $a->{index} <=> $b->{index}
      } @ranked;
}

# _scope_match_rank(%args)
# Scores one recursive scope-search file so exact basename hits outrank partial path matches.
# Input: file path string plus the active pattern array reference.
# Output: numeric rank where lower values are stronger matches.
sub _scope_match_rank {
    my (%args) = @_;
    my $file       = $args{file}       || '';
    my $match_path = $args{match_path} || $file;
    my @patterns   = @{ $args{patterns} || [] };
    my ($basename) = $match_path =~ m{([^/\\]+)$};
    $basename ||= $match_path;
    my $stem = $basename;
    $stem =~ s{\.[^.]+$}{};

    my $rank = 0;
    for my $pattern (@patterns) {
        next if !defined $pattern || $pattern eq '';
        my $regex = _compile_open_file_regex($pattern);
        my $score = 50;
        my @components = grep { defined && $_ ne '' } split m{[\\/]+}, $match_path;

        if ( $basename =~ /\A(?:$pattern)\z/i ) {
            $score = 0;
        }
        elsif ( $stem =~ /\A(?:$pattern)\z/i ) {
            $score = 1;
        }
        elsif ( $basename =~ /\A(?:$pattern)/i ) {
            $score = 2;
        }
        elsif ( $basename =~ $regex ) {
            $score = 3;
        }
        elsif ( grep { $_ =~ /\A(?:$pattern)\z/i } @components ) {
            $score = 4;
        }
        elsif ( $match_path =~ $regex ) {
            $score = 5;
        }

        $rank += $score;
    }

    return $rank;
}

# _resolve_open_file_matches(%args)
# Resolves direct file targets or recursive search matches for the open-file command.
# Input: path registry object and argv array reference.
# Output: list containing optional line number and matched file path strings.
sub _resolve_open_file_matches {
    my (%args) = @_;
    my $paths = $args{paths} || die 'Missing path registry';
    my @argv  = @{ $args{args} || [] };
    my ( $files, $config ) = _open_file_registries( paths => $paths );

    my $first = shift @argv;
    my $line  = 0;

    if ( defined $first && $first =~ /^(.+):(\d+)(?::\d+)?$/ ) {
        my ( $file, $parsed_line ) = ( $1, $2 );
        if ( -f $file ) {
            return ( $parsed_line, $file );
        }
    }

    if ( defined $first && -f $first ) {
        return ( $line, $first );
    }

    if ( defined $first ) {
        my $resolved_file = eval { $files->resolve_file($first) };
        return ( $line, $resolved_file ) if defined $resolved_file && $resolved_file ne '' && -f $resolved_file;
    }

    if ( defined $first ) {
        my @named_matches = _named_source_matches(
            paths => $paths,
            name  => $first,
        );

lib/Developer/Dashboard/CLI/OpenFile.pm  view on Meta::CPAN

# Input: path registry object, archive file path string, and relative Java source path string.
# Output: ordered list of extracted source file path strings.
sub _extract_java_sources_from_archive {
    my (%args) = @_;
    my $paths    = $args{paths}    || die 'Missing path registry';
    my $archive  = $args{archive}  || return;
    my $relative = $args{relative} || return;
    my $zip      = Archive::Zip->new();
    return if $zip->read($archive) != AZ_OK;

    my @matches;
    for my $entry ( _matching_java_archive_entries( zip => $zip, relative => $relative ) ) {
        my $member = $zip->memberNamed($entry) || next;
        my $target = _cached_archive_source_path(
            paths   => $paths,
            archive => $archive,
            entry   => $entry,
        );
        my ( $volume, $directories ) = File::Spec->splitpath($target);
        make_path( File::Spec->catpath( $volume, $directories, '' ) );
        open my $fh, '>', $target or die "Unable to write $target: $!";
        print {$fh} $member->contents;
        close $fh;
        push @matches, $target;
    }

    return @matches;
}

# _matching_java_archive_entries(%args)
# Finds archive member names whose trailing path matches one requested Java source path.
# Input: Archive::Zip object and relative Java source path string.
# Output: ordered list of matching archive member path strings.
sub _matching_java_archive_entries {
    my (%args) = @_;
    my $zip      = $args{zip}      || return;
    my $relative = $args{relative} || return;
    my $suffix   = $relative;
    $suffix =~ s{\\}{/}g;

    my @entries;
    for my $member ( $zip->members ) {
        my $name = $member->fileName || next;
        next if $name !~ /(?:\A|\/)\Q$suffix\E\z/;
        push @entries, $name;
    }

    return @entries;
}

# _cached_archive_source_path(%args)
# Builds the stable cache location used for one extracted Java source member.
# Input: path registry object, archive file path string, and archive member path string.
# Output: extracted source file path string.
sub _cached_archive_source_path {
    my (%args) = @_;
    my $paths   = $args{paths}   || die 'Missing path registry';
    my $archive = $args{archive} || die 'Missing archive path';
    my $entry   = $args{entry}   || die 'Missing archive entry';
    my $digest  = md5_hex( join "\0", $archive, $entry );
    my @parts   = grep { defined && $_ ne '' } split m{/+}, $entry;

    return File::Spec->catfile(
        $paths->cache_root,
        'open-file',
        'java-sources',
        $digest,
        @parts,
    );
}

# _download_java_source_matches(%args)
# Downloads Maven source jars when local archive lookup cannot satisfy the requested Java class.
# Input: path registry object, fully qualified class name string, and relative Java source path string.
# Output: ordered list of extracted Java source file path strings.
sub _download_java_source_matches {
    my (%args) = @_;
    my $paths    = $args{paths}    || die 'Missing path registry';
    my $name     = $args{name}     || return;
    my $relative = $args{relative} || return;

    my @matches;
    for my $doc ( _maven_search_documents($name) ) {
        next if ref($doc) ne 'HASH';
        next if !grep { defined && $_ eq '-sources.jar' } @{ $doc->{ec} || [] };
        my $archive = _download_maven_source_jar( paths => $paths, doc => $doc ) or next;
        push @matches,
          _extract_java_sources_from_archive(
            paths    => $paths,
            archive  => $archive,
            relative => $relative,
          );
        last if @matches;
    }

    return @matches;
}

# _maven_search_documents($name)
# Queries Maven Central for one fully qualified Java class name.
# Input: fully qualified Java class name string.
# Output: ordered list of Maven search document hash references.
sub _maven_search_documents {
    my ($name) = @_;
    return if !defined $name || $name eq '';

    my $query = uri_escape_utf8(qq{fc:"$name"});
    my $url   = "https://search.maven.org/solrsearch/select?q=$query&rows=20&wt=json";
    my $ua    = LWP::UserAgent->new( timeout => 10 );
    my $res   = $ua->get($url);
    return if !$res->is_success;

    my $payload = eval { decode_json( $res->decoded_content ) };
    return if !$payload || ref($payload) ne 'HASH';
    return @{ $payload->{response}{docs} || [] };
}

# _download_maven_source_jar(%args)
# Downloads one Maven Central source jar into the dashboard cache tree when it is missing.
# Input: path registry object and one Maven search document hash reference.
# Output: local source-jar path string or undef on failure.