ood-ports-lbsd/infrastructure/bin/out-of-date

#!/usr/bin/perl

# $OpenBSD: out-of-date,v 1.6 2013/09/15 09:17:25 rpe Exp $
#
# Copyright (c) 2005 Bernd Ahlers <bernd@openbsd.org>
#
# 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.

use strict;
use warnings;
use OpenBSD::Getopt;
use OpenBSD::Error;
use OpenBSD::PackageInfo;
use OpenBSD::PackingList;
use OpenBSD::PackageName;
use File::Temp;
use OpenBSD::AddCreateDelete;

our $opt_q;
my $state = OpenBSD::AddCreateDelete::State->new("out-of-date");
$state->handle_options('q', "[-mvxq]");

sub collect_installed
{
	my $pkg = {};

	$state->progress->for_list("Collecting installed packages",
	    [installed_packages(1)], sub {
		my $name = shift;
		my ($stem, $version) = OpenBSD::PackageName::splitname($name);
		my $plist = OpenBSD::PackingList->from_installation($name,
		    \&OpenBSD::PackingList::UpdateInfoOnly);
		if (!defined $plist or !defined $plist->{extrainfo}->{subdir}) {
			$state->errsay("Package #1 has no valid packing-list", 
			    $name);
			return;
		}
			
		my $subdir = $plist->{extrainfo}->{subdir};
		$subdir =~ s/mystuff\///;
		$subdir =~ s/\/usr\/ports\///;

		$pkg->{$subdir}->{name}	     = $name;
		$pkg->{$subdir}->{stem}      = $stem;
		$pkg->{$subdir}->{version}   = $version;
		my $sig = $plist->signature;
		if (ref($sig)) { $sig = $sig->string; }
		$pkg->{$subdir}->{signature} = $sig;
		if (defined $plist->{'always-update'}) {
			$pkg->{$subdir}->{signature} = 'always-update';
		}
	    });
	return $pkg;
}

sub open_cmd
{
	my $cmd = shift;
	open my $fh, "-|", $cmd;
#	my $old = select $fh;
#	$| = 1;
#	select $old;
	return $fh;
}

sub collect_port_versions
{
	my ($pkg, $portsdir, $notfound) = @_;

	my @subdirs = ();
	for my $subdir (keys %$pkg) {
		my ($dir) = split(/,/, $subdir);
		if (-d "$portsdir/$dir") {
			push(@subdirs, $subdir);
		} else {
			push(@$notfound, $subdir);
		}
	}

	my $cmd = "cd $portsdir && SUBDIR=\"".join(' ', @subdirs)
	    ."\" FULLPATH=Yes REPORT_PROBLEM=true make ".'show=FULLPKGNAME\${SUBPACKAGE} '
	    ."2>&1";

	my $port  = {};
	my $error = {};
	my $count = 0;
	my $total = scalar @subdirs;

	$state->progress->set_header("Collecting port versions");
	my $fh = open_cmd($cmd);
	my $subdir     = "";
	while (<$fh>) {
		chomp;
		if (/^\=\=\=\>\s+(\S+)/) {
			$subdir = $1;
			$count++;
			$state->progress->show($count, $total);
			next;
		}
		next unless $_ or $subdir;
		next if defined $error->{$subdir};
		if (/^(Fatal\:|\s+\()/) {
			push(@{$error->{$subdir}}, $_);
			next;
		} elsif (/^(Stop|\*\*\*)/) {
			next;
		}
		$port->{$subdir}->{name} = $_;
		my ($stem, $version) = OpenBSD::PackageName::splitname($_);
		$port->{$subdir}->{stem}    = $stem;
		$port->{$subdir}->{version} = $version;
	}
	close($fh);
	$state->progress->next;

	return $port, $error;
}

sub collect_port_signatures
{
	my $pkg      = shift;
	my $port     = shift;
	my $portsdir = shift;
	my $output   = shift;

	my @subdirs = ();
	for my $dir (keys %$port) {
		if ($pkg->{$dir}->{name} eq $port->{$dir}->{name}) {
			push(@subdirs, $dir);
		}
	}

	my $TMPDIR = $ENV{'TMPDIR'} || "/tmp";
	my $tempdir = File::Temp::tempdir("libcache.XXXXXXXXXX", DIR => $TMPDIR, CLEANUP => 1);
	$ENV{'_DEPENDS_CACHE'} = $tempdir;
	my $cmd = "cd $portsdir && FULLPATH=Yes SUBDIR=\"".join(' ', @subdirs)
	    ."\" REPORT_PROBLEM=true make print-package-signature";

	my $count = 0;
	my $total = scalar @subdirs;
	$state->progress->set_header("Collecting port signatures");
	my $fh = open_cmd($cmd);
	my $subdir     = "";
	while (<$fh>) {
		chomp;
		if (/^\=\=\=\>\s+(\S+)/) {
			$subdir = $1;
			$count++;
			$state->progress->show($count, $total);
			next;
		}
		next unless $_ or $subdir;
		$port->{$subdir}->{signature} = $_;
	}
	$state->progress->next;
}

sub split_sig
{
	my $sig = shift;
	my $ret = {};

	for my $item (split(/,/, $sig)) {
		$ret->{$item} = 1;
	}

	return $ret;
}

sub diff_sig
{
	my ($dir, $pkg, $port) = @_;

	my $old	= split_sig($pkg->{$dir}->{signature});
	my $new	= split_sig($port->{$dir}->{signature});

	for my $key (keys %$old) {
		if (defined $new->{$key}) {
			delete $old->{$key};
			delete $new->{$key};
		}
	}

	return join(',', sort keys %$old), join(',', sort keys %$new);
}

sub find_outdated
{
	my ($pkg, $port, $output) = @_;

	for my $dir (keys %$pkg) {
		next unless $port->{$dir};
		if ($pkg->{$dir}->{name} ne $port->{$dir}->{name}) {
			push(@$output, sprintf("%-30s # %s -> %s\n", $dir,
			    $pkg->{$dir}->{version}, $port->{$dir}->{version}));
			next;
		}
		next if $opt_q;
		if ($pkg->{$dir}->{signature} ne $port->{$dir}->{signature}) {
			push(@$output, sprintf("%-30s # %s -> %s\n", $dir,
			    diff_sig($dir, $pkg, $port)));
		}
	}
}

my $portsdir = $ENV{PORTSDIR} || "/usr/ports";


my $pkg = collect_installed();

my @output   = ();
my @notfound = ();
my ($port, $errors) = collect_port_versions($pkg, $portsdir, \@notfound);

collect_port_signatures($pkg, $port, $portsdir, \@output) unless $opt_q;
find_outdated($pkg, $port, \@output);

$state->errsay("Outdated ports:\n");
$state->print("#1", $_) for sort @output;

if ($opt_q) {
	$state->errsay("\nWARNING: You've used the -q option. With this,\n"
	    . "out-of-date only looks for changed package names\nbut not "
	    . "for changed package signatures. If you\nwant to see ALL "
	    . "of your outdated packages,\ndon't use -q.");
}

if (@notfound > 0) {
	$state->errsay("\nPorts that can't be found in the official "
	    . "ports tree:");
	for (sort @notfound) {
		$state->errsay("#1", $_);
	}
}
if ((keys %$errors) > 0) {
	$state->errsay("\nErrors:");
	for (sort keys %$errors) {
		$state->errsay("  #1", $_);
		$state->errsay("    #1", $_) for @{$errors->{$_}};
	}
}