#!/usr/bin/env perl
# latest-rpms --- filter a list of packages and print only the latest versions
# Author: Noah Friedman <friedman@splode.com>
# Created: 2005-07-24
# Public domain

# $Id: latest-rpms,v 1.7 2018/07/26 21:52:59 friedman Exp $

# Commentary:
# Code:

use strict;
use RPM2;
use Symbol;
use IO::Handle;
use Getopt::Long;

$^W = 1;  # enable warnings

# Disable all digest and signature verification; this will significantly
# speed up the reading in of package headers.
my $rpmpkg_flags;
map { $rpmpkg_flags |= RPM2->$_ }
    qw(vsf_nohdrchk
       vsf_nosha1header
                        vsf_nomd5
       vsf_nodsaheader  vsf_nodsa
       vsf_norsaheader  vsf_norsa);

my @uniq_keys = (qw(name arch));
my $verbose = -t fileno (STDERR);
(my $progname = $0) =~ s=.*/==;

sub rpm_uniq
{
  my ($list) = @_;
  my $tick = 0;
  my $uptick = 0;

  if ($verbose)
    {
      STDERR->autoflush (1);
      $tick = scalar @$list;
      # print a status on the number of read files every 5% of the total
      # number of files to read, or per 100 files, whichever is smaller.
      # This is to avoid flooding slow terminals.
      $uptick = int($tick * .05) || 1;
      $uptick = 100 if $uptick > 100;
    }

  my @pkg;
  my $i = 0;
  select (STDERR);
  map {
    if ($tick && (($tick - ++$i < 25) || $i % $uptick == 0))
      {
        printf "\r%s: reading file %d/%d ... ", $progname, $i, $tick;
      }
    eval { my $rpm = RPM2->open_package ($_, $rpmpkg_flags);
           $rpm->{filename} = $_; # open_package stores realpath; override
           push @pkg, $rpm;
         };
    if ($@)
      {
        print "\n" if $tick;
        print "$progname: $_: $@";
      }
  } @$list;

  # Uniquify using latest version of package per package name/arch.
  # This sort operation works correctly with unpadded version numbers
  # because <=> and cmp are overloaded to examine rpm headers in detail,
  # not just use lexicographic sorting.
  my %name;
  map { my $rpm = $_;
        my $key = join (".", map { $rpm->tag ($_) } @uniq_keys);
        $name{$key} = $_->{filename}
      } sort { $a <=> $b } @pkg;
  @pkg = sort values %name;

  print scalar @pkg, " unique packages\n" if $tick;

  select (STDOUT);
  map { print $_, "\n" } @pkg;

}

sub main
{
  Getopt::Long::config ('bundling', 'autoabbrev');
  GetOptions ("i|ignore-arch", sub { pop @uniq_keys },
              "q|quiet",       sub { $verbose = 0 });

  if (@ARGV == 0)
    {
      local $/ = undef;
      @ARGV = split (/[\r\n]+/, <STDIN>);
    }
  elsif (@ARGV == 1 && -d $ARGV[0])
    {
      my $dir = $ARGV[0];
      my $dh = gensym;
      opendir ($dh, $dir) || die "$progname: $dir: $!";
      @ARGV = grep { /\.rpm$/ } readdir ($dh);
      closedir ($dh);
      map { $_ = $dir . "/" . $_ } @ARGV unless $dir eq ".";
    }
  rpm_uniq (\@ARGV)
}

main;

# local variables:
# mode: perl
# end: