Bug 15304

	It's been one of those weekends.  I though I'd just tinker a
bit with pkg_version to make a few improvements and then I found I'd
pretty much completely rewritten it...  Anyhow, here are my changes
for general consideration.  The salient points are:

	- Add a new `-m' flag to filter against package names

	- Exhaustively compare all installed and available versions of
	packages: a possible answer to the `multiple versions' problem

	- Make the code emmited by -c conditional on the success of
	preceeding steps.  (This effectively duplicates the changes of
	PR15288, which I hadn't seen until just now)

	- Change default and verbose output formats to show version numbers
	and (verbose only) the corresponding directory from /usr/ports

	eg:

	> ./pkg_version.pl -m 'emacs' 
	emacs                          20.4 > 19.34b
	emacs                          20.4 = 20.4
	> ./pkg_version.pl -v -m 'emacs'
	emacs                          20.4 > 19.34b
	    succeeds index   for /usr/ports/editors/emacs
	
	emacs                          20.4 = 20.4
	    up-to-date       for /usr/ports/editors/emacs20
	

	- Made code comply better with recommendations of
	perlstyle(1).

Fix: Well, the diff is bigger than the new file, so here's the whole thing:
	


> diff -u /usr/src/usr.sbin/pkg_install/version/pkg_version.1 ./pkg_version.1   --- /usr/src/usr.sbin/pkg_install/version/pkg_version.1 Sat Dec  4 03:43:54 1999
+++ ./pkg_version.1     Mon Dec  6 12:31:41 1999
@@ -34,6 +34,7 @@
 .Nm pkg_version
 .Op Fl cdhv
 .Op Fl l Ar limchar
+.Op Fl m Ar pkgmatch
 .Op Ar index
 .Sh DESCRIPTION
 The
@@ -44,7 +45,9 @@
 command.  Version numbers are compared against an
 index file, to see which packages might need updating.
 .Pp
-Each package name is printed, along with a one-character status flag:
+Each package name is printed, along with the installed package version
+number, a one-character status flag and the available package version
+number.  The status flags are:
 .Bl -tag -width indent
 .It Li =
 The installed version of the package matches the index.
@@ -56,10 +59,13 @@
 index.
 .It Li ?
 The relationship between the installed version of a package and the
-index file could not be determined.  A common reason for this message
-is that there are multiple versions of a particular software package
-installed, or that multiple versions are listed in the index file.
-Examples from the
+index file could not be determined.  Usually this means that no
+matching package could be identified in the index.
+.Pp
+Where multiple versions of the same package have been installed, or
+where multiple versions of a package are listed in the index, several
+lines are output per package, one for each combination of installed
+and available package versions.  Examples from the
 .Fx
 ports collection are the Tcl toolkit or the
 .Tn EMACS
@@ -85,11 +91,19 @@
 to the shell, it is best to quote
 .Ar limchar
 with single quotes.
+.It Fl m
+Limit the output to just those installed packages that match the Perl
+regular expression
+.Ar pkgmatch .
+Both package names and version numbers may be matched against.  Single
+quotes may be required to protect characters with special meaning to
+the shell.
 .It Fl v
 Enable verbose output.  Verbose output includes some English-text
-interpretations of the version number comparisons, as well as the
-version numbers compared for each package.  Non-verbose output is
-probably easier for programs or scripts to parse.
+interpretations of the version number comparisons, the directory path
+in the ports system, as well as the version numbers compared for each
+package.  Non-verbose output is probably easier for programs or
+scripts to parse.
 .It Ar index
 Specify the index to be used as a basis of comparison.  This index can
 be specified as a filename (in the local filesystem) or a URL.  Any
@@ -105,7 +119,8 @@
 .Xr fetch 1 ,
 .Xr pkg_add 1 ,
 .Xr pkg_create 1 ,
-.Xr pkg_delete 1 .
+.Xr pkg_delete 1 ,
+.Xr perlre 1 .
 .Sh FILES
 .Bl -tag -width /usr/ports/INDEX -compact
 .It Pa /usr/ports/INDEX
@@ -133,15 +148,21 @@
 suggestions, and then cut-and-paste (or retype) the commands you want to run.
 .Pp
 .Dl % pkg_version -c > do_update
+.Pp
+Generate a report limited to just the EMACS or Xemacs packages:
+.Pp
+.Dl % pkg_version -m '^x?emacs'
+.Pp
+Generate a verbose report on all packages with lower case letters as
+part of their version numbers:
+.Pp
+.Dl % pkg_version -v -m '-[^-]*[a-z]+[^-]*$'
 .Sh AUTHOR
 .An Bruce A. Mah Aq bmah@ca.sandia.gov
 .Sh CONTRIBUTORS
 .An Nik Clayton Aq nik@FreeBSD.org ,
 .An Dominic Mitchell Aq dom@palmerharvey.co.uk
 .Sh BUGS
-There should be a better way of dealing with packages that
-can have more than one installed version.
-.Pp
 Patch levels aren't handled
 very well (i.e. version numbers of the form 1.2p3 or 1.2pl3).
 .Pp--CQwDFsV2cHrkeonLRn6OPglpkFDmrsKajo6N6ipw6OzgbyXb
Content-Type: text/plain; name="file.shar"
Content-Transfer-Encoding: 7bit
Content-Disposition: attachment; filename="file.shar"

# This is a shell archive.  Save it in a file, remove anything before
# this line, and then unpack it by entering "sh file".  Note, it may
# create directories; files and directories will be owned by you and
# have default permissions.
#
# This archive contains:
#
#	pkg_version.pl
#
echo x - pkg_version.pl
sed 's/^X//' >pkg_version.pl << 'END-of-pkg_version.pl'
X#! /usr/bin/perl -w
X#
X# Copyright 1998 Bruce A. Mah
X#
X# All rights reserved.
X#
X# Redistribution and use in source and binary forms, with or without
X# modification, are permitted provided that the following conditions
X# are met:
X# 1. Redistributions of source code must retain the above copyright
X#    notice, this list of conditions and the following disclaimer.
X# 2. Redistributions in binary form must reproduce the above copyright
X#    notice, this list of conditions and the following disclaimer in the
X#    documentation and/or other materials provided with the distribution.
X#
X# THIS SOFTWARE IS PROVIDED BY THE DEVELOPERS ``AS IS'' AND ANY EXPRESS OR
X# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
X# OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
X# IN NO EVENT SHALL THE DEVELOPERS BE LIABLE FOR ANY DIRECT, INDIRECT,
X# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
X# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
X# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
X# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
X# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
X# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
X#
X# pkg_version.pl
X#
X# A package version-checking utility for FreeBSD.
X#
X# $FreeBSD: src/usr.sbin/pkg_install/version/pkg_version.pl,v 1.2.2.2 1999/12/03 06:18:04 billf Exp $
X#
X
Xuse strict;
Xuse Getopt::Std;
Xuse vars qw { $opt_v $opt_h };
Xrequire "sysexits.ph";
X
X#
X# Program name for error messages: strip leading path
X#
X$0 =~ s@.*/@@;
X
X#
X# Configuration global variables
X#
X$::Version                = '0.1';
X$::CurrentPackagesCommand = '/usr/sbin/pkg_info -aI |';
X$::CatProgram             = "<"; # Just open a regular file for input
X$::FetchProgram           = "/usr/bin/fetch -o - ";
X
X#$::IndexFile = "ftp://ftp.freebsd.org/pub/FreeBSD/ports-current/INDEX";
X$::IndexFile              = 'file:/usr/ports/INDEX';
X$::ShowCommandsFlag       = 0;
X$::DebugFlag              = 0;
X$::VerboseFlag            = 0;
X$::CommentChar            = "#";
X$::LimitFlag              = "";
X$::PackageRE              = "."; # match anything regexp
X
X#
X# CompareVersions
X#
X# Try to figure out the relationship between two program version numbers.
X# Detecting equality is easy, but determining order is a little difficult.
X#
Xsub CompareVersions {
X    my $v1 = shift;
X    my $v2 = shift;
X    my @p1;
X    my @p2;
X
X    # Short-cut in case of equality
X    if ($v1 eq $v2) {
X	return 0;
X    }
X
X    # Loop over different components (the parts separated by dots).
X    # If any component differs, we have the basis for an inequality.
X    @p1 = split /\./, $v1;
X    @p2 = split /\./, $v2;
X
X    while (@p1 || @p2) {
X
X	# We\'re out of one or both components: if both, they\'re
X	# equal (this probably won\'t happen, since the short-cut case
X	# above should get this).  Otherwise, all else being equal,
X	# the longer version number is greater than the shorter: ie:
X	# 1.5.2 > 1.5
X	if (!(@p1 && @p2)) {
X	    return $#p1 <=> $#p2;
X	}
X	# Check for numeric inequality.  We assume here that (for example)
X	# 3.09 < 3.10. Only if there are no non-digits present.  Of course,
X	# there are always some problem packages: eg netscape-communicator
X	# where 4.08 < 4.7 
X	elsif ($p1[0] =~ /^\d+$/ &&
X	       $p2[0] =~ /^\d+$/ &&
X	       $p1[0] != $p2[0]) {
X	    return $p1[0] <=> $p2[0];
X	}
X	# Check for string inequality, given numeric equality.  This
X	# handles version numbers of the form 3.4j < 3.4k. However,
X	# if only one version has a non-numeric part, it sorts higher
X	# -- ie 1.5.2 < 1.5.2b1 (which is probably not correct), although
X	# 1.5.2 < 1.5.2p3 probably *is* correct.  Ho hum.
X	elsif ($p1[0] ne $p2[0]) {
X	    return $p1[0] cmp $p2[0];
X	}
X	shift @p1;
X	shift @p2;
X    }
X
X}
X
X#
X# GetNameAndVersion
X#
X# Get the name and version number of a package. Returns a two element
X# array, first element is name, second element is version number.
X#
Xsub GetNameAndVersion {
X    my $string = shift;
X
X    # If no hyphens then no version number
X    return ($string, "") if $string !~ /-/;
X
X    # Match (and group) everything in between two hyphens. Because the
X    # regexp is 'greedy', the first .* will try and match everything up
X    # to (but not including) the last hyphen
X    $string =~ /(.*)-(.*)/;
X    return ($1, $2);
X}
X
X#
X# PrintHelp
X#
X# Print usage information
X#
Xsub PrintHelp {
X    print <<"EOF"
X$0 $::Version
XBruce A. Mah <bmah\@ca.sandia.gov>
X
XUsage: $0 [-c] [-d debug] [-h] [-v] [index]
X-c              Show commands to update installed packages
X-d debug	Debugging output (debug controls level of output)
X-h		Help (this message)
X-l limchar	Limit output
X-m pkgregex     Only show packages matching regular expression
X-v		Verbose output
Xindex		URL or filename of index file
X		(Default is $::IndexFile)
XEOF
X}
X
X#
X# Parse command-line arguments, deal with them
X#
Xif (!getopts('cdhl:m:v') || ($opt_h)) {
X    &PrintHelp();
X    exit EX_USAGE();
X}
X$::ShowCommandsFlag = $::opt_c if $::opt_c;
X$::DebugFlag        = $::opt_d if $::opt_d;
X$::LimitFlag        = $::opt_l if $::opt_l;
X$::PackageRE        = $::opt_m if $::opt_m;
X$::VerboseFlag      = 1        if $::opt_v;
X$::IndexFile        = $ARGV[0] if $#ARGV >= 0;
X
X# Gross hack to get around a bug in fetch(1).  When PR bin/7203 gets fixed,
X# we can make a lot of this code go away...basically the problem is that
X# we can't depend on "fetch -o -" to do the right thing with files in the
X# filesystem.
Xif ($::IndexFile =~ s-^file:/-/-) {
X    $::IndexPackagesCommand = $::CatProgram . $::IndexFile;
X}
Xelsif ($::IndexFile =~ m-^(http|ftp)://-) {
X    $::IndexPackagesCommand = $::FetchProgram . $::IndexFile . "|";
X}
Xelse {
X    $::IndexPackagesCommand = $::CatProgram . $::IndexFile;
X}
X
X#
X# Slurp in files
X#
Xprint STDERR "$::CurrentPackagesCommand\n" if $::DebugFlag;
X
Xopen CURRENT, "$::CurrentPackagesCommand"
X    or die ("$0: Can't load current packages \"$::CurrentPackagesCommand\"",
X	    " -- $!\n");
Xwhile (<CURRENT>) {
X    my $packageString;
X    my $packageName;
X    my $packageVersion;
X    my $rest;
X
X    ($packageString, $rest) = split;
X    next unless $packageString =~ m/$::PackageRE/o;
X
X    ($packageName, $packageVersion) = &GetNameAndVersion($packageString);
X    $::currentPackages{$packageName}{'list'} = []
X	unless defined $::currentPackages{$packageName}{'list'};
X    push @{$::currentPackages{$packageName}{'list'}},
X        { ident  => $packageString,
X	  version => $packageVersion };
X    $::currentPackages{$packageName}{'refcount'}++;
X}
Xclose CURRENT;
X
Xprint STDERR "$::IndexPackagesCommand\n" if $::DebugFlag;
X
Xopen INDEX, "$::IndexPackagesCommand"
X    or die "$0: Can't load index \"$::IndexPackagesCommand\" -- $!\n";
Xwhile (<INDEX>) {
X    my $packageString;
X    my $packagePath;
X    my $packageName;
X    my $packageVersion;
X    my $rest;
X
X    ($packageString, $packagePath, $rest) = split(/\|/);
X    ($packageName, $packageVersion) = &GetNameAndVersion($packageString);
X
X    $::indexPackages{$packageName}{'list'} = []
X	unless defined $::indexPackages{$packageName}{'list'};
X    push @{$::indexPackages{$packageName}{'list'}},
X        { ident   => $packageString,
X	  version => $packageVersion,
X	  path    => $packagePath };
X    $::indexPackages{$packageName}{'refcount'}++;
X}
Xclose INDEX;
X
XMAIN:
X{
X    my $packageName;
X    my $packagePath;
X    my $indexVersion;
X    my $currentVersion;
X    my $packageNameVer;
X    my $comment;
X    my $versionCode;
X
X    #
X    # Select report type
X    #
X    $~ = "STDOUT_VERBOSE"  if $::VerboseFlag;
X    $~ = "STDOUT_COMMANDS" if $::ShowCommandsFlag;
X
X    #
X    # Produce reports: there may be multiple versions of the package
X    # listed in the index, or none (eg. the package name has changed as
X    # happened when "egcs" mutated into "gcc").  There can be multiple
X    # versions installed.  Account for all combinations.
X    #
X    foreach $packageName (sort keys %::currentPackages) {
X
X	foreach my $cur (@{$::currentPackages{$packageName}{'list'}}) {
X	    $currentVersion = $cur->{version};
X	    $packageNameVer = "$packageName-$cur->{version}";
X
X	    if (!defined $::indexPackages{$packageName}) {
X		# Nothing matches in the index
X		$versionCode  = "?";
X		$comment      = "unknown in index";
X		$packagePath  = "";
X		$indexVersion = "???";
X
X		next if $::ShowCommandsFlag; # Can't rebuild if doesn't exist
X
X		if ($::LimitFlag) {
X		    write if $versionCode =~ m/[$::LimitFlag]/o; 
X		} else {
X		    write;
X		} 
X	    } else {
X		# Compare each installed version to each index entry
X		foreach my $idx (@{$::indexPackages{$packageName}{'list'}}) {
X		    my $rc;
X
X		    $indexVersion = $idx->{version};
X		    $packagePath = $idx->{path};
X		    $rc = &CompareVersions($cur->{version}, $idx->{version});
X	    
X		    if ($rc == 0) {
X			next if $::ShowCommandsFlag;
X			$versionCode = "=";
X			$comment = "up-to-date";
X		    }
X		    elsif ($rc < 0) {
X			$versionCode = "<";
X			$comment = "update available";
X		    }
X		    elsif ($rc > 0) {
X			next if $::ShowCommandsFlag;
X			$versionCode = ">";
X			$comment = "succeeds index";
X		    }
X		    if ($::LimitFlag) {
X			write if $versionCode =~ m/[$::LimitFlag]/o; 
X		    } else {
X			write;
X		    } 
X		}
X	    }
X	}
X    }
X
X    #
X    # Formats
X    #
X    # $CommentChar is in the formats because you can't put a literal '#' in
X    # a format specification
X    
X    # General report (no output flags)
X    format STDOUT =
X@<<<<<<<<<<<<<<<<<<<< @>>>>>>>>>>>> @ @<<<<<<<<<<<<<
X$packageName,         $currentVersion, $versionCode, $indexVersion
X.
X    ;
X
X    # Verbose report (-v flag)
X    format STDOUT_VERBOSE =
X@<<<<<<<<<<<<<<<<<<<< @>>>>>>>>>>>> @ @<<<<<<<<<<<<<
X$packageName,         $currentVersion, $versionCode, $indexVersion
X    @<<<<<<<<<<<<<<< for @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
X    $comment,            $packagePath
X
X.
X    ;
X
X    # Report that includes commands to update program (-c flag)
X    format STDOUT_COMMANDS =
X@
X$::CommentChar  
X@ @<<<<<<<<<<<<<<<<<<<<<<<<
X$::CommentChar, $packageNameVer
X@ Index has @<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
X$::CommentChar, $indexVersion, $comment  
X@
X$::CommentChar
Xcd @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
X$packagePath
Xmake && \
Xpkg_delete -f @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
X              "$packageNameVer && \\"
Xmake install
X
X.
X    ;
X    exit EX_OK();
X}
X#
X# That's all folks!
X#
END-of-pkg_version.pl
exit
How-To-Repeat: 
	N/A