update_plugin_list

#!/usr/bin/perl

use warnings;
use strict;
use File::Copy qw/move/;
use File::Slurp qw/read_file/;
use JSON::XS qw/encode_json decode_json/;
use Carp qw/confess/;
use Fcntl qw/:mode :flock/;
use LWP::UserAgent;

################################################################################
# input source file
my $source_file = 'plugin/source.json';

# output list file
my $output_file = 'plugin/list';

################################################################################

main();
exit;

################################################################################
sub main {
    my $input  = decode_json(read_file($source_file));
    my $output = _array2hash(-s $output_file ? decode_json(read_file($output_file)) : [], 'name');
    for my $plugin (sort { $a->{'name'} cmp $b->{'name'} } @{$input}) {
        if(_update_plugin($plugin)) {
            if($output->{$plugin->{'name'}} && $output->{$plugin->{'name'}}->{'version'} ne $plugin->{'version'}) {
                printf("%s updated %s -> %s\n", $plugin->{'name'}, $output->{$plugin->{'name'}}->{'version'}, $plugin->{'version'});
            }
            _json_lock_store($output_file, $input, 1);
        } elsif($output->{$plugin->{'name'}}) {
            # fetching new release failed, use old one if available
            my $old = $output->{$plugin->{'name'}};
            for my $key (qw/name version tarball description/) {
                $plugin->{$key} = $old->{$key} if $old->{$key};
            }
        }
    }
    return;
}

################################################################################
sub _update_plugin {
    my($plugin) = @_;
    if($plugin->{'url'} =~ m|https://github.com/([^/]+)/(.*)$|mx) {
        my($owner, $repo) = ($1, $2);
        my $data;
        eval {
            $data = decode_json(_get_page(sprintf('https://api.github.com/repos/%s/%s/tags', $owner, $repo)));
        };
        if($@) {
            warn(sprintf("fetching releases for %s (%s) failed: %s", $plugin->{'name'}, $plugin->{'url'}, $@));
            return;
        }
        my $release = $data->[0];
        $plugin->{'version'} = $release->{'name'};
        $plugin->{'tarball'} = $release->{'tarball_url'};

        # fetch description
        my $description;
        eval {
            $description = _get_page(sprintf('https://raw.githubusercontent.com/%s/%s/master/description.txt', $owner, $repo));
        };
        if($@) {
            warn(sprintf("fetching description for %s (%s) failed: %s", $plugin->{'name'}, $plugin->{'url'}, $@));
        } else {
            $description =~ s/^Version:.*$//gmx;
            $description =~ s/^Url:.*$//gmx;
            $description =~ s/^\s+//gmx;
            $description =~ s/\s+$//gmx;
            $plugin->{'description'} = $description;
        }
    }
    else {
        warn("unsupported input url scheme: ".Dumper($plugin));
        return;
    }
    return($plugin);
}


################################################################################
sub _get_page {
    my($url) = @_;
    my $ua     = LWP::UserAgent->new;
    $ua->timeout(10);
    $ua->env_proxy;
    my $response = $ua->get($url);
    if(!$response->is_success) {
        die($response->status_line);
    }
    return($response->decoded_content);
}

################################################################################
sub _json_lock_store {
    my($file, $data, $changed_only) = @_;

    my $json = JSON::XS->new->utf8;
    $json = $json->pretty;
    $json = $json->canonical;

    my $write_out = $json->encode($data);
    if($changed_only && -f $file) {
        my $old = read_file($file);
        return 1 if $old eq $write_out;
    }

    my $tmpfile = $file.'.new';
    open(my $fh2, '>', $tmpfile) or confess('cannot write file '.$tmpfile.': '.$!);
    print $fh2 $write_out or confess('cannot write file '.$tmpfile.': '.$!);
    close($fh2);
    open(my $fh, '>', $file) or confess('cannot write file '.$file.': '.$!);
    alarm(30);
    local $SIG{'ALRM'} = sub { confess("timeout while trying to lock_ex: ".$file); };
    flock($fh, LOCK_EX) or confess 'Cannot lock '.$file.': '.$!;
    move($tmpfile, $file) or confess("cannot replace $file with $tmpfile: $!");
    alarm(0);
    return 1;
}

################################################################################
sub _array2hash {
    my($array, $key) = @_;
    my $hash = {};
    for my $item (@{$array}) {
        $hash->{$item->{$key}} = $item;
    }
    return($hash);
}

################################################################################