ports/databases/sqlports/files/mksqlitedb

#! /usr/bin/perl
# $OpenBSD: mksqlitedb,v 1.63 2023/09/06 11:56:34 espie Exp $
#
# Copyright (c) 2006-2010 Marc Espie <espie@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.

# example script that shows how to store all variable values into a
# database, using SQLite for that purpose.
#
# usage: cd /usr/ports && mksqlitedb

use v5.36;
use FindBin;
use lib $FindBin::Bin;
use Getopt::Std;
use Var;
use Inserter;
use DBI;
use PkgPath;
use Info;
use TreeWalker;
use Trace;


package MyTreeWalker;
our @ISA = (qw(TreeWalker));

sub new($class, $inserter, @r)
{
	my $o =  $class->SUPER::new(@r);
	$o->{inserter} = $inserter;
	return $o;
}

sub inserter($self)
{
	return $self->{inserter};
}

sub handle_value($self, $o, $var, $value, $arch)
{
	$o->{info} //= Info->new($o);
	$o->{info}->create($var, $value, $arch, $o);
}

sub parse_dump($self, $fd, $subdirs)
{
	$self->SUPER::parse_dump($fd, $subdirs);
	$self->inserter->commit_to_db;
}

sub create_missing_vars($self, $o)
{
	for my $name (qw(SHARED_LIBS TARGETS)) {
		if (!defined $o->{info}->{vars}{$name}) {
			$o->{info}->create($name, '', undef, $o);
		}
	}
}

sub handle_path($self, $pkgpath, $equivs)
{
	$self->create_missing_vars($pkgpath);
	my $key = $pkgpath->fullpkgpath;
	while (defined $equivs->{$key}) {
		$key = $equivs->{$key};
	}
	if ($pkgpath->{info}{done}) {
		print "--- $key (already done)\n";
		return;
	}
	print "+++ $key\n";
	$self->inserter->set_newkey($key);
	for my $var ($pkgpath->{info}->variables) {
		$self->inserter->add_var($var);
	}
	$pkgpath->{info}->reclaim;
	$pkgpath->{info}{done} = 1;
	$pkgpath->{done} = 1;
	$self->inserter->finish_port;
}

package main;
use Digest::SHA;
use MIME::Base64;

sub digest($filename)
{
	my $d = Digest::SHA->new(256);
	$d->addfile($filename);
	return encode_base64($d->digest, '');
}

our ($opt_v, $opt_q, $opt_p, $opt_V, $opt_C, $opt_w, $opt_s, $opt_S);

Trace->setup(\%SIG);
getopts('svq:p:V:C:w:S:');
my $dbname;
if (@ARGV == 1) {
	$dbname = shift;
} elsif (@ARGV == 0) {
	$dbname = 'sqlports';
} else {
	exit 1;
}

my $db = DBI->connect("dbi:SQLite:dbname=$dbname", '', '', {AutoCommit => 0});
my $inserter = Inserter->new($db, 1000, $opt_v, 1);


$inserter->create_tables($Info::vars);

if ($opt_p) {
	$ENV{'REPORT_PROBLEM_LOGFILE'}= $opt_p;
}

my $walker = MyTreeWalker->new($inserter, $opt_s, $opt_S);
if (defined $opt_C) {
	open(my $f, '>', $opt_C) or die;
	my $cache = "PortsQ";
	say $f "DROP TABLE if exists $cache;";
	say $f Sql::Create->find('ports')->cache($cache), ";";
	say $f "INSERT INTO $cache select * from Ports;";
	say $f "ANALYZE;";
	close $f;
}

if (defined $opt_w) {
	open(my $f, '>', $opt_w) or die;
	for my $v (Sql::Create->all_views) {
		say $f $v->drop, ";";
		say $f $v->stringize, ";";
	}
	close $f;
}

use Baseline;

BaselineMixin->prime(Baseline->get);

$walker->dump_all_dirs;

# Create aliases, we have to sort the keys so that they are
# created in the right pkgpath order
for my $p (sort keys %{$walker->{equivs}}) {
	my $a = $p;
	while (defined $walker->{equivs}{$a}) {
		$a = $walker->{equivs}{$a};
	}
	$walker->inserter->add_path($p, $a);
}

$walker->inserter->commit_to_db;
$walker->inserter->insert("Meta", $opt_V, digest($dbname));
$walker->inserter->commit_to_db;
$db->disconnect;

while (my ($k, $v) = each %$Info::unknown) {
	say STDERR "Unknown variable $k in ", $v->fullpkgpath;
}

if (defined $opt_q) {
	open(my $log, ">", $opt_q) or die $!;
	$walker->inserter->write_log($log);
} else {
	$walker->inserter->write_log(\*STDERR);
}