[pkgsrc/trunk]: pkgsrc/pkgtools/lintpkgsrc lintpkgsrc: use plain text cache f...

[rillig <rillig%pkgsrc.org@localhost>]

details:   https://anonhg.NetBSD.org/pkgsrc/rev/78c86b1fd1db
branches:  trunk
changeset: 382523:78c86b1fd1db
user:      rillig <rillig%pkgsrc.org@localhost>
date:      Sat Jul 30 11:33:23 2022 +0000

description:
lintpkgsrc: use plain text cache format

Previously, the cache format was Perl code. Now it is a list of lines,
each line containing tab-separated data.

The new format reduces the storage needs by around 50%. It also ensures
that only well-formed data is written to the cache.

The previous format contained lots of IO requests, which made loading
the cache incredibly slow.

Bump version.

diffstat:

 pkgtools/lintpkgsrc/Makefile            |   5 +-
 pkgtools/lintpkgsrc/files/lintpkgsrc.pl |  97 ++++++++++++++------------------
 2 files changed, 46 insertions(+), 56 deletions(-)

diffs (167 lines):

diff -r 0329abe5d3b3 -r 78c86b1fd1db pkgtools/lintpkgsrc/Makefile
--- a/pkgtools/lintpkgsrc/Makefile      Sat Jul 30 10:55:51 2022 +0000
+++ b/pkgtools/lintpkgsrc/Makefile      Sat Jul 30 11:33:23 2022 +0000
@@ -1,7 +1,6 @@
-# $NetBSD: Makefile,v 1.40 2022/07/30 10:11:45 rillig Exp $
+# $NetBSD: Makefile,v 1.41 2022/07/30 11:33:23 rillig Exp $
 
-PKGNAME=       lintpkgsrc-4.98
-PKGREVISION=   1
+PKGNAME=       lintpkgsrc-4.99
 CATEGORIES=    pkgtools
 
 MAINTAINER=    pkgsrc-users%NetBSD.org@localhost
diff -r 0329abe5d3b3 -r 78c86b1fd1db pkgtools/lintpkgsrc/files/lintpkgsrc.pl
--- a/pkgtools/lintpkgsrc/files/lintpkgsrc.pl   Sat Jul 30 10:55:51 2022 +0000
+++ b/pkgtools/lintpkgsrc/files/lintpkgsrc.pl   Sat Jul 30 11:33:23 2022 +0000
@@ -1,6 +1,6 @@
 #!@PERL5@
 
-# $NetBSD: lintpkgsrc.pl,v 1.36 2022/07/30 10:55:51 rillig Exp $
+# $NetBSD: lintpkgsrc.pl,v 1.37 2022/07/30 11:33:23 rillig Exp $
 
 # Written by David Brownlee <abs%netbsd.org@localhost>.
 #
@@ -78,23 +78,11 @@
 
 sub store($) {
        my $self = shift;
-       my @pkgs = keys %{$self->{_pkgs}};
-       my ($cnt, $subcnt) = $self->count;
 
-       print("\$pkgcnt = $cnt;\n");
-       print("\$subpkgcnt = $subcnt;\n");
-       map($self->{_pkgs}{$_}->store, keys %{$self->{_pkgs}});
-}
-
-sub count($) {
-       my $self = shift;
-       my ($pkgcnt, $pkgsubcnt);
-
-       map {
-               $pkgcnt++;
-               $pkgsubcnt += $self->{_pkgs}{$_}->count;
-       } keys %{$self->{_pkgs}};
-       wantarray ? ($pkgcnt, $pkgsubcnt) : $pkgcnt;
+       my $pkgs = $self->{_pkgs};
+       foreach my $pkg (sort keys %$pkgs) {
+               $pkgs->{$pkg}->store();
+       }
 }
 
 # Pkgs is all versions of a given package (eg: apache-1.x and apache-2.x)
@@ -148,14 +136,10 @@
 sub store($) {
        my $self = shift;
 
-       print("\$pkgnum++;\n");
-       map($self->{_pkgver}{$_}->store, keys %{$self->{_pkgver}});
-}
-
-sub count($) {
-       my $self = shift;
-
-       scalar(keys %{$self->{_pkgver}});
+       my $pkgvers = $self->{_pkgver};
+       foreach my $pkgver (sort keys %$pkgvers) {
+               $pkgvers->{$pkgver}->store();
+       }
 }
 
 # PkgVer is a unique package+version
@@ -207,17 +191,19 @@
 
 sub store($) {
        my $self = shift;
-       my $data;
 
-       ($data = $self->{_pkg}) =~ s/([\\\$\@\%\"])/\\$1/g;
-       print("\$pkgver = \$pkglist->add(\"$data\", \"");
+       my $name = $self->{_pkg};
+       my $ver = $self->{_ver};
 
-       ($data = $self->{_ver}) =~ s/([\\\$\@\%\"])/\\$1/g;
-       print("$data\"); __pkgcount(1);\n");
+       $name =~ /\s/ and die "cannot store package name '$name'\n";
+       $ver =~ /\s/ and die "cannot store package version '$ver'\n";
+       printf("package\t%s\t%s\n", $name, $ver);
 
-       foreach ($self->vars) {
-               ($data = $self->{$_}) =~ s/([\\\$\@\%\"])/\\$1/g;
-               print("\$pkgver->var(\"$_\", \"$data\");\n");
+       foreach my $varname (sort $self->vars) {
+               my $value = $self->{$varname};
+               $varname =~ /\s/ and die "cannot store variable name '$varname'\n";
+               $value =~ /\n/ and die "cannot store variable value '$value'\n";
+               printf("var\t%s\t%s\n", $varname, $value);
        }
 }
 
@@ -397,8 +383,7 @@
 
        # XXX Could do something with target
        while ($test =~ /(target|empty|make|defined|exists)\s*\(([^()]+)\)/) {
-               my $testname = $1;
-               my $varname = $2;
+               my ($testname, $varname) = ($1, $2);
                my $var;
 
                # Implement (some of) make's :M modifier
@@ -1175,14 +1160,23 @@
 }
 
 sub load_pkgsrc_makefiles($) {
+       my ($fname) = @_;
 
-       open(STORE, "<$_[0]") || die("Cannot read pkgsrc store from $_[0]: $!\n");
+       open(STORE, "<", $fname)
+           or die("Cannot read pkgsrc store from $fname: $!\n");
        my ($pkgver);
-       our ($pkgcnt, $pkgnum, $subpkgcnt, $subpkgnum);
-       $pkglist = new PkgList;
-       while (<STORE>) {
-               debug("eval store $_");
-               eval $_;
+       $pkglist = PkgList->new;
+       while (defined(my $line = <STORE>)) {
+               chomp($line);
+               if ($line =~ qr"^package\t([^\t]+)\t([^\t]+$)$") {
+                       $pkgver = $pkglist->add($1, $2);
+               } elsif ($line =~ qr"^var\t([^\t]+)\t(.*)$") {
+                       $pkgver->var($1, $2);
+               } elsif ($line =~ qr"^sub ") {
+                       die "Outdated cache format in '$fname'\n";
+               } else {
+                       die "Invalid line '$line' in cache '$fname'\n";
+               }
        }
        close(STORE);
 }
@@ -1377,18 +1371,15 @@
 }
 
 sub store_pkgsrc_makefiles($) {
-       open(STORE, ">$_[0]") || die("Cannot save pkgsrc store to $_[0]: $!\n");
-       my $was = select(STORE);
-       print(
-           'sub __pkgcount { $subpkgnum += $_[0]; ',
-           'verbose("\rReading pkgsrc database: ',
-           '$pkgnum / $pkgcnt ($subpkgnum / $subpkgcnt) pkgs"); }',
-           "\n"
-       );
-       $pkglist->store;
-       print("verbose(\"...done\\n\");\n");
-       select($was);
-       close(STORE);
+       my ($fname) = @_;
+
+       open(STORE, ">", $fname)
+           or die("Cannot save pkgsrc store to $fname: $!\n");
+       my $prev = select(STORE);
+       $pkglist->store();
+       select($prev);
+       close(STORE)
+           or die("Cannot save pkgsrc store to $fname: $!\n");
 }
 
 # Remember to update manual page when modifying option list