Skip to content
Browse files

base page fetching on Mojo::UserAgent instead of LWP::Simple, since t…

…he latter does not seem to work with SSL on that particular box
  • Loading branch information...
1 parent e583214 commit a2051d9321b56a2b2b11c27ef1d2be5d0cdf6c3d @moritz moritz committed
Showing with 44 additions and 17 deletions.
  1. +2 −0 Build.PL
  2. +42 −17 web/build-project-list.pl
View
2 Build.PL
@@ -12,6 +12,8 @@ my $build = Module::Build->new(
# and now the list of perl module dependencies
requires => {
'HTML::Template' => 0,
+ 'Mojolicious' => 0,
+ 'YAML' => 0,
}
);
$build->create_build_script;
View
59 web/build-project-list.pl
@@ -4,13 +4,34 @@
use 5.010;
use Data::Dumper;
-use LWP::Simple;
+use Mojo::UserAgent;
+use Mojo::IOLoop;
use JSON;
use YAML qw (Load LoadFile);
use HTML::Template;
use File::Slurp;
use Encode qw(encode_utf8);
+# LWP::Simple doesn't seem to like https, even when IO::Socket::INET
+# and Crypt::SSLeay are installed. So replace its functions with
+# Mojolicious
+my $ua = Mojo::UserAgent->new->ioloop(Mojo::IOLoop->new->connect_timeout(10));
+sub get {
+ $ua->get($_[0])->res->body
+}
+sub json_get {
+ $ua->get($_[0])->res->json
+}
+sub head {
+ $ua->get($_[0])->success
+}
+sub getstore {
+ open my $f, '>', $_[1] or die "Cannot open '$_[1]' for writing: $!";
+ print { $f } get($_[0]);
+ close $f or warn "Error while closing file '$_[1]': $!";
+ 1;
+}
+
my $output_dir = shift(@ARGV) || './';
my @MEDALS = qw<fresh medal readme tests unachieved proto camelia panda>;
binmode STDOUT, ':encoding(UTF-8)';
@@ -18,18 +39,18 @@
local $| = 1;
my $stats = { success => 0, failed => 0, errors => [] };
-my $list_url = 'https://github.com/perl6/ecosystem/raw/master/META.list';
+my $list_url = 'https://raw.github.com/perl6/ecosystem/master/META.list';
my $site_info = {
'github' => {
set_project_info => sub {
my ($project , $previous )= @_;
- $project->{url} = "http://github.com/$project->{auth}/$project->{repo_name}/";
+ $project->{url} = "https://github.com/$project->{auth}/$project->{repo_name}/";
if ( ! head( $project ->{url} ) ) {
return "Error for project $project->{name} : could not get $project->{url} (project probably dead)\n";
}
- my $commits = decode_json get("http://github.com/api/v2/json/commits/list/$project->{auth}/$project->{repo_name}/master");
+ my $commits = json_get("https://github.com/api/v2/json/commits/list/$project->{auth}/$project->{repo_name}/master");
my $latest = $commits->{commits}->[0];
$project ->{last_updated}= $latest->{committed_date};
my ($yyy,$mm,$dd)= (localtime (time - (90*3600*24) ))[5,4,3,] ; $yyy+=1900;$mm++; #There must be a better way to get yymmdd for 90 days ago
@@ -45,15 +66,15 @@
}
print "Updated since last check\n";
- my $repository = decode_json get ("http://github.com/api/v2/json/repos/show/$project->{auth}/$project->{repo_name}");
+ my $repository = json_get ("https://github.com/api/v2/json/repos/show/$project->{auth}/$project->{repo_name}");
$project ->{description}= $repository->{repository}->{description};
- my $tree = decode_json get("http://github.com/api/v2/json/tree/show/$project->{auth}/$project->{repo_name}/$latest->{id}");
+ my $tree = json_get("https://github.com/api/v2/json/tree/show/$project->{auth}/$project->{repo_name}/$latest->{id}");
my %files = map { $_->{name} , $_->{type} } @{ $tree->{tree} };
#try to get the logo if any
if ( -e "$output_dir/logos" && $files{logotype} ) {
- my $logo_url = "http://github.com/$project->{auth}/$project->{repo_name}/raw/master/logotype/logo_32x32.png";
+ my $logo_url = "https://raw.github.com/$project->{auth}/$project->{repo_name}/master/logotype/logo_32x32.png";
if ( head($logo_url) ) {
my $logo_name = $project->{name};
$logo_name =~ s/\W+/_/;
@@ -124,16 +145,20 @@ sub get_projects {
my $projects;
my $contents = eval { read_file('META.list.local') } || get($list_url);
for my $proj (split "\n", $contents) {
- my $json = decode_json encode_utf8 get $proj;
- my $name = $json->{'name'};
- my $url = $json->{'source-url'} // $json->{'repo-url'};
- my ($auth, $repo_name)
- = $url =~ m[git://github.com/([^/]+)/([^.]+).git];
- $projects->{$name}->{'home'} = "github";
- $projects->{$name}->{'auth'} = $auth;
- $projects->{$name}->{'repo_name'} = $repo_name;
- $projects->{$name}->{'url'} = $url;
- $projects->{$name}->{'badge_panda'} = defined $json->{'source-url'};
+ print "$proj\n";
+ eval {
+ my $json = json_get $proj;
+ my $name = $json->{'name'};
+ my $url = $json->{'source-url'} // $json->{'repo-url'};
+ my ($auth, $repo_name)
+ = $url =~ m[git://github.com/([^/]+)/([^.]+).git];
+ $projects->{$name}->{'home'} = "github";
+ $projects->{$name}->{'auth'} = $auth;
+ $projects->{$name}->{'repo_name'} = $repo_name;
+ $projects->{$name}->{'url'} = $url;
+ $projects->{$name}->{'badge_panda'} = defined $json->{'source-url'};
+ };
+ warn $@ if $@;
}
my $cached_projects = eval { decode_json read_file( $output_dir . 'proto.json' , binmode => ':encoding(UTF-8)' ) };

0 comments on commit a2051d9

Please sign in to comment.
Something went wrong with that request. Please try again.