view release on metacpan or  search on metacpan

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

# 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.
sub _download_maven_source_jar {
    my (%args) = @_;
    my $paths = $args{paths} || die 'Missing path registry';
    my $doc   = $args{doc}   || return;
    return if ref($doc) ne 'HASH';
    return if !defined $doc->{g} || !defined $doc->{a} || !defined $doc->{v};

    my $group_path = join '/', split /\./, $doc->{g};
    my $file       = "$doc->{a}-$doc->{v}-sources.jar";
    my $target     = File::Spec->catfile(
        $paths->cache_root,
        'open-file',
        'maven-sources',
        split( /\//, $group_path ),
        $doc->{a},
        $doc->{v},
        $file,
    );
    return $target if -f $target;

    my ( $volume, $directories ) = File::Spec->splitpath($target);
    make_path( File::Spec->catpath( $volume, $directories, '' ) );

    my $url = join '/',
      'https://repo1.maven.org/maven2',
      $group_path,
      $doc->{a},
      $doc->{v},
      $file;
    my $ua  = LWP::UserAgent->new( timeout => 20 );
    my $res = $ua->mirror( $url, $target );
    return if !$res->is_success && $res->code != 304;
    return -f $target ? $target : undef;
}

# _command_exit($code)
# Wraps process exit so tests can override it and exercise command flow in-process.
# Input: integer process exit code.
# Output: never returns during normal command execution.
sub _command_exit {
    my ($code) = @_;
    exit $code;
}

# _command_exec(@command)
# Wraps process exec so tests can override it and inspect the final editor command.
# Input: shell command array.
# Output: never returns during normal command execution.
sub _command_exec {
    my (@command) = @_;
    exec { $command[0] } @command;
}