view release on metacpan or  search on metacpan

lib/Pod/Minicpandoc.pm  view on Meta::CPAN

        return "https://fastapi.metacpan.org/v1/source/$module";
    }
    else {
        return "https://fastapi.metacpan.org/v1/pod/$module?content-type=text/x-pod";
    }
}

sub unlink_tempfiles {
    my $self = shift;
    return $self->opt_l ? 0 : 1;
}

sub fetch_url {
    my $self = shift;
    my $url  = shift;

    $self->aside("Going to query $url\n");

    if ($ENV{MCPANDOC_FETCH}) {
        print STDERR "Fetching $url\n";
    }

    my $ua = HTTP::Tiny->new(
        agent => "mcpandoc/$VERSION",
        verify_SSL => 1,
    );

    my $response = $ua->get($url);

    if (!$response->{success}) {
        $self->aside("Got a $response->{status} error from the server\n");
        return;
    }

    $self->aside("Successfully received " . length($response->{content}) . " bytes\n");
    return $response->{content};
}

sub query_live_cpan_for {
    my $self   = shift;
    my $module = shift;

    my $url = $self->live_cpan_url($module);
    my $content = $self->fetch_url($url);

    if ($self->opt_c) {
        $content = JSON::PP::decode_json($content)->{content};
        $content = "=pod\n\n$content";
    }

    return $content;
}

sub use_minicpan {
    my ( $self ) = @_;

    my $rc_file = File::Spec->catfile((getpwuid $<)[7], '.minicpanrc');
    return -e $rc_file;
}

sub get_minicpan_path {
    my ( $self ) = @_;

    my $rc_file = File::Spec->catfile((getpwuid $<)[7], '.minicpanrc');
    my $minicpan_path;

    my $fh;
    unless(open $fh, '<', $rc_file) {
        $self->aside("Unable to open '$rc_file': $!");
        return;
    }
    while(<$fh>) {
        chomp;
        if(/local:\s*(.*)/) {
            $minicpan_path = $1;
            last;
        }
    }
    close $fh;

    return $minicpan_path;
}

sub find_module_archive {
    my ( $self, $module ) = @_;

    my $minicpan_path = $self->get_minicpan_path;

    unless(defined $minicpan_path) {
        $self->aside("Unable to parse minicpan path from .minicpanrc");
        return;
    }

    my $packages = File::Spec->catfile($minicpan_path, 'modules',
        '02packages.details.txt.gz');

    my $h = IO::Uncompress::Gunzip->new($packages);

    my $archive_path;

    while(<$h>) {
        chomp;
        if(/^\Q$module\E\s/) {
            ( undef, undef, $archive_path ) = split;
            last;
        }
    }
    close $h;

    if($archive_path) {
        $archive_path = File::Spec->catfile($minicpan_path, 'authors', 'id',
            $archive_path);
    }
    return $archive_path;
}

sub load_archive {
    my ( $self, $archive_path ) = @_;

    my $archive;

    if($archive_path =~ /\.zip$/) {
        $archive = Archive::Zip->new;
        unless($archive->read($archive_path) == AZ_OK) {
            undef $archive;
        }
    } else { # assume it's a tarball
        $archive = Archive::Tar->new($archive_path);
    }

    return $archive;
}

sub get_archive_files {
    my ( $self, $archive ) = @_;

    if($archive->isa('Archive::Zip')) {
        return $archive->memberNames;
    } else {
        return $archive->list_files;
    }
}

sub find_module_file {
    my ( $self, $module, @files ) = @_;

    my %topdirs = map {
        my $file = $_;
        $file    =~ s!/.*!!;
        $file => 1;
    } @files;

    my $prefix = '';
    if(keys(%topdirs) == 1) { # if all files begin with the same directory,
                              # we strip the top level directory to make
                              # finding files under strange archives easier
        ( $prefix ) = keys(%topdirs);
        $prefix .= '/';
        @files = map { s/^\Q$prefix\E//; $_ } @files;
    }

    my @tests;

    if($self->opt_c) {
        @tests = (
            'Changes',
        );
    } else {
        $module =~ s!::!/!g;
        my $pod = $module;