view release on metacpan or  search on metacpan

lib/Bot/Cobalt/Plugin/Extras/CPAN.pm  view on Meta::CPAN

  broadcast( 'www_request',
    $request,
    'mcpan_plug_resp_recv',
    $hints
  );
}

sub Bot_mcpan_plug_resp_recv {
  my ($self, $core) = splice @_, 0, 2;
  my $response = ${ $_[1] };
  my $hints    = ${ $_[2] };

  my $dist = $hints->{Dist};
  my $type = $hints->{Type};
  my $link = $hints->{Link};

  unless ($response->is_success) {
    my $status = $response->code;
    if ($status == 404) {
      broadcast( 'message',
        $hints->{Context}, $hints->{Channel},
        "No such distribution: $dist"
      );
    } else {
      broadcast( 'message',
        $hints->{Context}, $hints->{Channel},
        "Could not get release info for $dist ($status)"
      );
    }
    return PLUGIN_EAT_ALL
  }

  my $json = $response->content;
  unless ($json) {
    broadcast('message',
      $hints->{Context}, $hints->{Channel},
      "Unknown failure -- no data received for $dist",
    );
    return PLUGIN_EAT_ALL
  }

  my $d_hash = 
    try { $Serializer->thaw($json) } 
    catch {
      broadcast( 'message',
        $hints->{Context}, $hints->{Channel},
        "thaw failure; err: $_",
      );
      undef
    } or return PLUGIN_EAT_ALL;

  unless ($d_hash && ref $d_hash eq 'HASH') {
    broadcast( 'message',
      $hints->{Context}, $hints->{Channel},
      "thaw failure for $dist; expected a HASH but got '$d_hash'"
    );
    return PLUGIN_EAT_ALL
  }

  my $resp;
  my $prefix = color bold => 'mCPAN';

  TYPE: {

    if ($type eq 'abstract') {
      my $abs  = $d_hash->{abstract} || 'No abstract available.';
      my $vers = $d_hash->{version};
      $resp = "$prefix: ($dist $vers) $abs ; $link";
      last TYPE
    }

    if ($type eq 'dist') {
      my $dl = $d_hash->{download_url} || 'No download link available.';
      $resp = "$prefix: ($dist) $dl";
      last TYPE
    }

    if ($type eq 'latest') {
      my $vers = $d_hash->{version};
      my $arc  = $d_hash->{archive};
      $resp = "$prefix: ($dist) Latest is $vers ($arc) ; $link";
      last TYPE
    }

    if ($type eq 'license') {
      my $name = $d_hash->{name};
      my $lic  = join ' ', @{ $d_hash->{license}||['undef'] };
      $resp = "$prefix: License terms for $name:  $lic";
      last TYPE
    }

    if ($type eq 'tests') {
      my %tests = %{
        keys %{$d_hash->{tests}||{}} ?
          $d_hash->{tests}
          : { pass => 0, fail => 0, na => 0, unknown => 0 }
      };

      my $vers = $d_hash->{version};

      $resp = sprintf("%s: (%s %s) %d PASS, %d FAIL, %d NA, %d UNKNOWN",
        $prefix, $dist, $vers,
        $tests{pass}, $tests{fail}, $tests{na}, $tests{unknown}
      );

      last TYPE
    }

    if ($type eq 'belongs') {
      my $release = $d_hash->{release};
      $resp = "$prefix: $dist belongs to release $release";
      last TYPE
    }

    if ($type eq 'changes') {
      my $release = $d_hash->{release};
      my $actuald = substr $release, 0, rindex $release, '-';
      my $link = "https://www.metacpan.org/changes/distribution/$actuald";
      $resp = "$prefix: Changes for $release: $link";
      last TYPE
    }