Skip site navigation (1)Skip section navigation (2)
Date:      Thu, 28 Nov 2013 01:09:10 +0000 (UTC)
From:      Matthias Andree <mandree@FreeBSD.org>
To:        ports-committers@freebsd.org, svn-ports-all@freebsd.org, svn-ports-head@freebsd.org
Subject:   svn commit: r335075 - in head/ports-mgmt/pkgs_which: . files
Message-ID:  <201311280109.rAS19AMn096181@svn.freebsd.org>

next in thread | raw e-mail | index | archive | help
Author: mandree
Date: Thu Nov 28 01:09:09 2013
New Revision: 335075
URL: http://svnweb.freebsd.org/changeset/ports/335075

Log:
  New version 0.4.0
  
  - Support pkgNG. Known issue is that pkg which returns bogus exit codes,
    spamming your screen.  pkgs_which works nonetheless.
    https://github.com/freebsd/pkg/issues/657
  
    Note that pkgNG always uses --nocache implictly for speed:
    https://github.com/freebsd/pkg/issues/658
  
    Known issue: the pkgNG detection is a hack. It just looks for the
    executable and the database in default locations, but does not attempt
    to run "pkg -N".

Modified:
  head/ports-mgmt/pkgs_which/Makefile
  head/ports-mgmt/pkgs_which/files/pkgs_which

Modified: head/ports-mgmt/pkgs_which/Makefile
==============================================================================
--- head/ports-mgmt/pkgs_which/Makefile	Wed Nov 27 23:57:23 2013	(r335074)
+++ head/ports-mgmt/pkgs_which/Makefile	Thu Nov 28 01:09:09 2013	(r335075)
@@ -2,7 +2,7 @@
 # $FreeBSD$
 
 PORTNAME=	pkgs_which
-PORTVERSION=	0.3.0
+PORTVERSION=	0.4.0
 CATEGORIES=	ports-mgmt perl5
 MASTER_SITES=	# none
 DISTFILES=	# none

Modified: head/ports-mgmt/pkgs_which/files/pkgs_which
==============================================================================
--- head/ports-mgmt/pkgs_which/files/pkgs_which	Wed Nov 27 23:57:23 2013	(r335074)
+++ head/ports-mgmt/pkgs_which/files/pkgs_which	Thu Nov 28 01:09:09 2013	(r335075)
@@ -112,6 +112,8 @@ $ENV{'PATH'} = '/bin:/usr/bin:/sbin:/usr
 
 # Where pkg_info lives
 my $PKG_INFO = '/usr/sbin/pkg_info';
+my $PKGNG = '/usr/local/sbin/pkg';
+my $PKGNGDB = '/var/db/pkg/local.sqlite';
 
 # Which regexp to use for laundering tainted file
 # and package names - note that this must not be let
@@ -125,6 +127,9 @@ my $cacheall = 1;
 
 my $rc = 0;
 
+my $PKGNG_MODE = 0;
+if (-e $PKGNG and -e $PKGNGDB) { $PKGNG_MODE = 1; }
+
 # Clean environment a bit
 delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
 
@@ -157,7 +162,10 @@ unless (@ARGV) {
 	-message => "You must give a file or directory on the command line.");
 }
 
-# declare subroutines 
+# listing all files from pkgNG is quite slow, so avoid
+if ($PKGNG_MODE and $cacheall) { $cacheall = 0; }
+
+# declare subroutines
 
 sub wanted;
 sub debug;
@@ -165,6 +173,30 @@ sub safebacktick(@);
 sub readcache();
 sub readorigins();
 
+my $pf2p;
+my $pfiles;
+my $pogn;
+my $pall;
+my $pallomap;
+my $pfilesmulti;
+
+if ($PKGNG_MODE) {
+    $pf2p = sub ($) { return safebacktick($PKGNG, 'which', '-q', $_[0]); };
+    $pfiles = sub ($) { return safebacktick($PKGNG, 'info', '-ql', $_[0]); };
+    $pogn = sub ($) { return safebacktick($PKGNG, 'info', '-qo', $_[0]); };
+    $pall = sub () { return safebacktick($PKGNG, 'info', '-q'); };
+    $pallomap = sub () { return map { s/\s+/:/; $_; }
+	safebacktick($PKGNG, 'info', '-o', '-a'); };
+    $pfilesmulti = sub (@) { return safebacktick($PKGNG, 'info', '-l', @_); };
+} else {
+    $pf2p = sub ($) { return safebacktick($PKG_INFO, '-qGW', $_[0]); };
+    $pfiles = sub ($) { return safebacktick($PKG_INFO, '-qGL', $_[0]); };
+    $pogn = sub ($) { return safebacktick($PKG_INFO, '-qGo', $_[0]); };
+    $pall = sub () { return safebacktick($PKG_INFO, '-EG', '-a'); };
+    $pallomap = sub () { return safebacktick($PKG_INFO, '-QGoa'); };
+    $pfilesmulti = sub (@) { return safebacktick($PKG_INFO, '-QGL', @_); };
+}
+
 # define variables
 
 my %ufiles = ();
@@ -215,7 +247,7 @@ my $f;
 while ($f = each %ufiles) {
     # Find package for file $f and store in $p:
     debug "matching $f\n";
-    my $p = $cacheall ? $$f2p{$f} : safebacktick($PKG_INFO, '-qGW', $f);
+    my $p = $cacheall ? $$f2p{$f} : &$pf2p($f);
     if (!$p) {
 	debug "file $f not in packages\n";
 	push @notfound, $f;
@@ -233,7 +265,7 @@ while ($f = each %ufiles) {
 
     # Obtain file list for package and purge from %ufiles:
     push @pkgs, $p;
-    my @pf = $cacheall ? @{$$pfl{$p}} : safebacktick($PKG_INFO, '-qGL', $p);
+    my @pf = $cacheall ? @{$$pfl{$p}} : &$pfiles($p);
     chomp @pf;
     debug "deleting files @pf\n";
     delete @ufiles{@pf};
@@ -243,9 +275,9 @@ while ($f = each %ufiles) {
 # If desired, map package names to package origins:
 if ($origins) {
     if ($cacheall) {
-	@pkgs = map { $p2o{$_}; } @pkgs;
+	@pkgs = map { $_ = $p2o{$_}; } @pkgs;
     } else {
-	@pkgs = map { $_ = safebacktick($PKG_INFO, '-qGo', $_); chomp $_; $_; } @pkgs;
+	@pkgs = map { $_ = &$pogn($_); chomp $_; $_; } @pkgs;
     }
 }
 
@@ -293,7 +325,7 @@ sub safebacktick(@) {
 	@data = <KID>;
 	close KID
 	    or warn $! ? "Error reading from kid: $!"
-		       : "Exit status $? from kid.";
+		       : "Exit status $? from kid";
     } else {
 	debug "running '", join("' '", @args), "'\n";
 	exec { $args[0] } @args;
@@ -307,7 +339,7 @@ sub safebacktick(@) {
 sub readcache() {
     my %f2p = (); # file-to-package hash (string, string)
     my %pfl = (); # package-files hash (string, array)
-    my @pkgs = map { $_ =~ $UNTAINT; $1; } safebacktick($PKG_INFO, '-EG', '-a');
+    my @pkgs = map { $_ =~ $UNTAINT; $1; } &$pall();
     my $n = scalar @pkgs;
     debug "subreadcache: got $n packages.\n";
     # Request file lists of so many packages at once, to save the
@@ -315,7 +347,7 @@ sub readcache() {
     # This speeds up things by an order of magnitude or so.
     my $chunksize = 100;
     while (my @p = splice(@pkgs, 0, $chunksize)) {
-	my @fl = safebacktick($PKG_INFO, '-QGL', @p);
+	my @fl = &$pfilesmulti(@p);
 	chomp @fl;
 	my $pkg;
 	map {
@@ -324,10 +356,11 @@ sub readcache() {
 		$pkg = $1;
 		$pkg =~ s/:$//; # strip trailing colon
 	    }
+	    s/^\s+//o;
 	    if ($_) { # file name
 		if ($pkg) { $f2p{$_} = $pkg; push @{$pfl{$pkg}}, $_;}
 		else { warn "pkg_info fault, missed package prefix before line $_."; }
-	    } else {
+	    } elsif ($_ ne '') {
 		warn "tainted file name in $pkg: $_"; 
 	    }
 	} @fl;
@@ -339,7 +372,7 @@ sub readcache() {
 # build a hash of package-to-origin and return it
 sub readorigins() {
     my %p2o = ();
-    my @ol = safebacktick($PKG_INFO, '-QGoa');
+    my @ol = &$pallomap();
     chomp @ol;
     my ($k, $v);
     map { $_ =~ $UNTAINT;
@@ -373,6 +406,18 @@ L<pkg_info>(8), L<portmaster>(8), L<port
 
 =head1 HISTORY
 
+0.4.0 2013-11-28
+  - support pkgNG. Known issue is that pkg which returns bogus exit
+    codes, spamming your screen.  pkgs_which works nonetheless.
+    https://github.com/freebsd/pkg/issues/657
+
+    Note that pkgNG always uses --nocache implictly for speed:
+    https://github.com/freebsd/pkg/issues/658
+
+    Known issue: the pkgNG detection is a hack. It just looks for the
+    executable and the database in default locations, but does not
+    attempt to run "pkg -N".
+
 0.3.0 2013-03-11
   - read pkg_info -L information in chunks of 100 packages at a time,
     to avoid forking once per package, which was slow.



Want to link to this message? Use this URL: <https://mail-archive.FreeBSD.org/cgi/mid.cgi?201311280109.rAS19AMn096181>