summaryrefslogtreecommitdiff
blob: 3b0abec46f317a97ca64076152294354464b91b5 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
#!/usr/bin/env perl

eval 'echo "Called with something not perl"' && exit 1    # Non-Perl protection.
  if 0;

use 5.14.2;
use strict;
use warnings;

use FindBin;
use lib "$FindBin::Bin/lib";

use env::gentoo::perl_experimental;
use metacpan qw( mcpan );
use Try::Tiny;
use optparse;

# FILENAME: pvlist.pl
# CREATED: 16/10/11 20:16:03 by Kent Fredric (kentnl) <kentfredric@gmail.com>
# ABSTRACT: Show dist metadata for interesting perl dists

# DEPENDENCIES:
#
# * MetaCPAN::API
# * CHI
# * WWW::Mechanize::Cached
# * HTTP::Tiny::Mech
# * Data::Dump
# * Gentoo::PerlMod::Version
#

my $optparse = optparse->new(
  argv => \@ARGV,
  help => sub { print help(); },
);
my $search = {};
$search->{query} = { constant_score => { filter => { terms => { distribution => $optparse->extra_opts } } } };
$search->{sort} = [  { 'date' => 'desc', }, ];
$search->{size} = 5000;
$search->{fields} = [qw(
  abstract
  archive
  author
  authorized
  date
  distribution
  download_url
  license
  maturity
  name
  status
  version
)];

_log( ['initialized: fetching search results'] );

my $results = mcpan->post( 'release/_search', $search );

_log( [ 'fetched %s results', scalar @{ $results->{hits}->{hits} } ] );

my $data = {};


for my $result ( @{ $results->{hits}->{hits} } ) {
  if ( not $result->{fields} ) {
    $result->{fields} = $result->{_source};
  }
  delete $result->{fields}->{dependency} if exists $result->{fields}->{dependency};
  my $fields = $result->{fields};

  my $cversion = $fields->{name};
  my $cdistrib = $fields->{distribution};
  $cversion =~ s/^${cdistrib}-//;

  $fields->{version_canon} = $cversion;
  $fields->{version_gentoo} = scalar try { gv( $cversion , { lax => 1 } ) };
  $fields->{archive_canon} = $fields->{author} . '/' . $fields->{archive};
  $data->{ $cdistrib } = [] unless exists $data->{ $cdistrib };
  push @{ $data->{ $cdistrib } }, $fields ;
}

require JSON;

my $encode = JSON->new->pretty->utf8->canonical;
say $encode->encode( $data  );

exit 0;

# Utils

sub pp { require Data::Dump; goto \&Data::Dump::pp }
sub gv { require Gentoo::PerlMod::Version; goto \&Gentoo::PerlMod::Version::gentooize_version }

sub _log {
  return unless $optparse->long_opts->{trace};
  return *STDERR->print(@_) if ( not ref $_[0] );

  state $prefix = "\e[7m* package_map.pl:\e[0m ";

  my ( $str, @args ) = @{ $_[0] };
  $str =~ s/\n?$/\n/;

  *STDERR->print($prefix);
  *STDERR->printf( $str, @args );
  return;

}



sub help {
  return <<"EOF";
package_map.pl

USAGE:

  package_map.pl PACKAGE [PACKAGE*][--help] [--trace]

  ie:

  # Show full metadata for Moose, Catalyst-Runtime and Dist-Zilla
  package_log.pl Moose Catalyst-Runtime Dist-Zilla

  # Be verbose about what we're doing
  package_log.pl Moose --trace

    --help        Show this message
    --trace       Turn on extra debugging.

EOF

}