From 15128b94b496324a1c0afd6cbdd7fffbdaa18ba7 Mon Sep 17 00:00:00 2001
From: "B. Watson" <yalhcru@gmail.com>
Date: Thu, 17 Jun 2021 01:58:33 -0400
Subject: Initial commit.

---
 bin/makepkgdb.pl | 235 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 235 insertions(+)
 create mode 100755 bin/makepkgdb.pl

(limited to 'bin/makepkgdb.pl')

diff --git a/bin/makepkgdb.pl b/bin/makepkgdb.pl
new file mode 100755
index 0000000..31838d3
--- /dev/null
+++ b/bin/makepkgdb.pl
@@ -0,0 +1,235 @@
+#!/usr/bin/perl -w
+
+# create database for limnoria bot Slackpkg plugin.
+# reads PACKAGES.txt from the main (slackware64) and extra
+# trees. Also has to have a copy of /var/log/scripts, since
+# PACKAGES.txt doesn't have symlinks, and a copy of
+# /var/log/packages since PACKAGES.txt doesn't have file contents.
+
+# the output is a huge pile of SQL insert statements, like half
+# a million of them. best way to run this IMO:
+# $ makepkgdb.pl > db.sql
+# $ rm -f /path/to/dbfile
+# $ sqlite3 -bail /path/to/dbfile < db.sql
+
+# this script was only tested for slackware 14.2. When 15.0 gets
+# released, we'll rebuild the database using this script, which
+# might or might not need to be modified.
+
+# special cases: /lib64/incoming gets the /incoming removed, and
+# we manually add /bin/bash.
+
+### configurables:
+
+@pkglists = (
+	'/data/mirrors/slackware/slackware64-14.2/PACKAGES.TXT',
+	'/data/mirrors/slackware/slackware64-14.2/extra/PACKAGES.TXT',
+);
+
+# ...the above list could have included pasture and testing, but
+# for that to work, you'd also have to have all the packages from
+# pasture and testing installed (we don't right now).
+
+# these 2 are copies of /var/log/packages and /var/log/scripts from
+# a full install of 14.2, with no 3rd-party packages added:
+$pkgdir = "/home/urchlay/var.log/packages";
+$scriptsdir = "/home/urchlay/var.log/scripts";
+
+### end configurables.
+
+sub init_db {
+	#unlink("testdb.sqlite3");
+	#open P, "|sqlite3 testdb.sqlite3";
+	#select P;
+
+	print <<EOF;
+pragma journal_mode = memory;
+begin transaction;
+
+-- should include extra (and maybe pasture?)
+create table categories (
+  id integer primary key not null,
+  name text(10) not null
+);
+
+-- compressed and uncompressed size?
+create table packages (
+  id integer primary key not null,
+  name varchar not null,
+  descrip varchar not null,
+  category integer not null,
+  foreign key(category) references categories(id)
+);
+
+-- path should be something bigger than a varchar? (does it matter, for sqlite?)
+create table files (
+  id integer primary key not null,
+  path varchar not null,
+  symlink boolean not null default 0,
+  package integer not null,
+  foreign key(package) references packages(id),
+  check(symlink in (0,1))
+);
+
+EOF
+}
+
+
+# turn e.g. bash-completion-2.2-noarch-3 into bash-completion
+# (supports arbitrary number of - in the package name).
+sub getpkgname {
+	my $p = reverse shift;
+	(undef, undef, undef, $p) = split("-", $p, 4);
+	return reverse $p;
+}
+
+# return ref-to-array of symlinks extracted from a scripts/ file.
+sub getsymlinks {
+	my @links = ();
+	open my $f, "<$_[0]" or return \@links;
+	while(<$f>) {
+		next unless /^\( cd (\S+) ; ln -sf \S+ (\S+) \)/;
+		my $dir = $1;
+		my $file = $2;
+		#warn "link $dir/$file\n" if $_[0] =~ /bash-4/;
+		push @links, "$dir/$file";
+	}
+	close $f;
+	#warn "links: " . join(" ", @links) . "\n" if $_[0] =~ /bash-4/;
+	return \@links;
+}
+
+# return ref-to-array of files extracted from a packages/ file.
+sub getfiles {
+	my @files = ();
+	open my $f, "<$_[0]" or return \@files;
+	while(<$f>) {
+		last if /^FILE LIST:/;
+	}
+	while(<$f>) {
+		chomp;
+		next if m,^\./$,;
+		next if m,^install/,;
+      s,^lib64/incoming,lib64,;
+		push @files, $_;
+	}
+	close $f;
+	push @files, "bin/bash" if $_[0] =~ /\/bash-[0-9]/;
+	return \@files;
+}
+
+# given a package db entry as a multi-line string, extract the
+# short description from it.
+sub getdescrip {
+	my $pkgname = shift;
+	my $blob = shift;
+	if($blob =~ /^$pkgname:\s+(\S.*)$/m) {
+		my $line = $1;
+		if($line =~ /^$pkgname (?:- )?\((.+)\)/) {
+			$line = $1;
+		}
+		return $line;
+	}
+	return '(no description)';
+}
+
+# given a package db entry as a multi-line string, extract the
+# category from it.
+sub getcategory {
+	my $pkgname = shift;
+	my $blob = shift;
+	if($blob =~ /^PACKAGE LOCATION:\s+\.\/(?:(extra)|(?:slackware64\/(\w+)))/m) {
+		return $1 ? $1 : $2;
+	}
+	return "(unknown category)";
+}
+
+sub getfilelist {
+	my $pkgname = shift;
+	return @{$files{$pkgname}};
+}
+
+sub getsymlinklist {
+	my $pkgname = shift;
+	if(defined $symlinks{$pkgname}) {
+		return @{$symlinks{$pkgname}};
+	} else {
+		return ();
+	}
+}
+
+$catcount = 0;
+sub getcategory_id {
+	my $catname = shift;
+	my $cat_id = $catname2id{$catname};
+	if(defined $cat_id) {
+		return $cat_id;
+	}
+	$catcount++;
+	print "insert into categories values($catcount, '$catname');\n";
+	$catname2id{$catname} = $catcount;
+	return $catcount;
+}
+
+### main()
+
+# build hash of all symlinks, indexed by package name.
+warn "reading symlinks from $scriptsdir/*\n";
+while(<$scriptsdir/*>) {
+	s,.*/,,;
+	my $p = getpkgname($_);
+	$symlinks{$p} = getsymlinks($scriptsdir . "/" . $_);
+}
+
+warn "reading filelists from $pkgdir/*\n";
+while(<$pkgdir/*>) {
+	s,.*/,,;
+	my $p = getpkgname($_);
+	$files{$p} = getfiles($pkgdir . "/" . $_);
+}
+
+#print for getfilelist('bash');
+#die;
+
+init_db();
+
+$pkg_id = 0;
+for(@pkglists) {
+	local $/ = '';
+	open my $l, "<$_" or die $!;
+	warn "reading package list from $_\n";
+	while(<$l>) {
+		next unless /^PACKAGE NAME:\s+(\S+)/;
+		my $pkgname = getpkgname($1);
+		my $descrip = getdescrip($pkgname, $_);
+		my $category = getcategory($pkgname, $_);
+		my $cat_id = getcategory_id($category);
+		$pkg_id++;
+
+		$descrip =~ s,','',g;
+		print "insert into packages values ($pkg_id, '$pkgname', '$descrip', $cat_id);\n";
+
+		my @filelist = getfilelist($pkgname);
+		my @symlinklist = getsymlinklist($pkgname);
+
+		for my $f (@filelist) {
+			print "insert into files values (null, '/$f', 0, $pkg_id);\n"
+		}
+
+		for my $f (@symlinklist) {
+			print "insert into files values (null, '/$f', 1, $pkg_id);\n"
+		}
+
+		#print "=== $cat_id: $category/$pkgname - $descrip\n";
+		#print "files: " . join("\n  ", @filelist) . "\n";
+		#print "links: " . join("\n   ", @symlinklist) . "\n\n";
+
+	}
+	close $l;
+}
+
+print "commit;\n";
+
+exit 0;
+
+
-- 
cgit v1.2.3