view release on metacpan or  search on metacpan

lib/PGXN/API/Sync.pm  view on Meta::CPAN

    # c: checkum has changed, file will be updated
    # s: file size has changed, file will be updated
    # t: modtime has changed, file will be updated
    # +++++++: New item
}


sub validate_distribution {
    my ($self, $fn) = shift->_rel_to_mirror(@_);
    my $meta     = PGXN::API->instance->read_json_from($fn);
    my $zip_path = $self->download_for($meta);

    # Validate it against the SHA1 checksum.
    say '  Checksumming ', $zip_path if $self->verbose;
    if ($self->digest_for($zip_path) ne $meta->{sha1}) {
        warn "Checksum verification failed for $fn\n";
        return;
    }

    # Unpack the distribution.
    my $zip = $self->unzip($zip_path, $meta) or return;
    return { meta => $meta, zip => $zip };
}

sub download_for {
    my ($self, $meta) = @_;
    my $zip_uri = $self->mirror_uri_templates->{download}->process(
        dist    => lc $meta->{name},
        version => lc $meta->{version},
    );

    my (undef, @segments) = $zip_uri->path_segments;
    return catfile @segments;
}

sub digest_for {
    my ($self, $fn) = shift->_rel_to_mirror(@_);
    open my $fh, '<:raw', $fn or die "Cannot open $fn: $!\n";
    my $sha1 = Digest::SHA1->new;
    $sha1->addfile($fh);
    return $sha1->hexdigest;
}

sub unzip {
    say '  Extracting ', $_[1] if $_[0]->verbose;
    my ($self, $zip_path, $meta) = shift->_rel_to_mirror(@_);

    my $zip = Archive::Zip->new;
    if ($zip->read(rel2abs $zip_path) != AZ_OK) {
        warn "Error reading $zip_path\n";
        return;
    }

    my $dist_dir = catdir(
        PGXN::API->instance->source_dir,
        lc $meta->{name}
    );
    make_path $dist_dir unless -e $dist_dir && -d _;

    foreach my $member ($zip->members) {
        my $fn = catfile $dist_dir, split m{/} => $member->fileName;
        say "    $fn\n" if $self->verbose > 2;

        if ($member->isSymbolicLink) {
            # Delete exsting so Archive::Zip won't fail to create it.
            warn "Cannot unlink $fn: $!\n" if -e $fn && !unlink $fn;
        } else {
            # Make sure the member is readable by everyone.
            $member->unixFileAttributes( $member->isDirectory ? 0755 : 0644 );
        }

        if ($member->extractToFileNamed($fn) != AZ_OK) {
            warn "Error extracting $fn from $zip_path\n";
            next;
        }
    }

    return $zip;
}

sub _rel_to_mirror {
    return shift, catfile(+PGXN::API->instance->mirror_root, shift), @_;
}

__PACKAGE__->meta->make_immutable(inline_destructor => 0);

1;

__END__

=head1 Name

PGXN::API::Sync - Sync from a PGXN mirror and update the index

=head1 Synopsis

  use PGXN::API::Sync;
  PGXN::API::Sync->new(
      source     => $source,
      rsync_path => $rsync_path,
      verbose    => $verbose,
  )->run;

=head1 Description

This module provides the implementation for L<pgxn_api_sync>, the command-line
utility for syncing to a PGXN mirror and creating the API. It syncs to the
specified PGXN rsync source URL, which should be a PGXN mirror server, and
then verifies and unpacks newly-uploaded distributions and hands them off to
L<PGXN::API::Indexer> to index.

=head1 Class Interface

=head2 Constructor

=head3 C<new>

  my $sync = PGXN::API::Sync->new(%params);

Creates and returns a new PGXN::API::Sync object. The supported parameters
are: