list installed packages with new upstream releases (via portroach.openbsd.org) - usage: pkg_info -qP | get_outdated

get_outdated

#!/usr/bin/perl
#
# Copyright (c) 2014 Andrew Fresh <andrew@afresh1.com>
# Copyright (c) 2015 Fabian Raetz <fabian.raetz@gmail.com>
#
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
#
# usage: pkg_info -qP | get_outdated

use strict;
use warnings;

my @all_outdated = @{ FetchOutdated->new->all_outdated_cached() };
while (<>) {
    chomp;
    my $pkgpath = $_;
    my @outdated = grep { $pkgpath eq $_->{fullpkgpath} } @all_outdated;
    print "$_->{fullpkgpath} $_->{ver} $_->{newver} $_->{maintainer}\n" for @outdated;
}


package FetchOutdated;
use 5.010;

use Carp qw( croak );
use JSON::PP qw( decode_json encode_json );
use POSIX qw( strftime );

sub get_cmd  { qw( ftp -o- ) }

sub new {
    my ($class, %args) = @_;
    return bless {%args}, $class;
}

sub base_url {'http://portroach.openbsd.org/json/'}

sub outdated { [ grep { $_->{newver} } @{ shift->get(@_) || [] } ] }

sub all_outdated {
    my $self = shift;
    my @outdated = ();
    foreach my $maintainer (@{ $self->maintainer_with_outdated() }) {
        push @outdated, @{ $self->outdated($maintainer) };
    }

    return [ @outdated ];
}

sub maintainer_with_outdated {
    return [
        map { $_->{maintainer} }
        grep { $_->{withnewdistfile} ne '0' }
        @{ shift->get('totals')->{results} || [] }
    ];
}

sub get {
    my ( $self, $m ) = @_;
    return $self->_get_json("$m.json");
}

sub _get {
    my ($self, $url) = @_;

    my $base_url = $self->base_url();

    for ( 0 .. 2 ) {
        open my $fh, '-|', $self->get_cmd, "$base_url$url" or croak $!;
        my $content = do { local $/ = undef; <$fh> };
        close $fh;
        return $content if $content;
        sleep 2 * $_;
    }

    croak "Failed to get $base_url/$url";
}

sub _get_json { return decode_json( shift->_get(@_) ) }

sub all_outdated_cached {
    my $cache = strftime "/tmp/get_outdated-%Y%d%m.cache", localtime;
    my $outdated;

    if (-e "$cache") {
        open(my $fh, "<", $cache) or croak $!;
        $outdated = decode_json(<$fh>);
    } else {
        $outdated = shift->all_outdated();
        open(my $fh, ">", $cache) or croak $!;
        print $fh encode_json($outdated);
    }

    return $outdated;
}