openbsd-ports/databases/sqlports/files/mksqlitedb

#! /usr/bin/perl
# $OpenBSD: mksqlitedb,v 1.41 2013/01/06 21:20:58 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 && make dump-vars |mksqlitedb

use strict;
use warnings;
use FindBin;
use lib $FindBin::Bin;
use Getopt::Std;
use Column;
use Var;
use Inserter;
use DBI;
use PkgPath;
use Info;

$SIG{__WARN__} = sub {
	require Carp;

	my $_ = pop @_;
	s/(.*)( at .*? line .*?\n$)/$1/s;
	push @_, $_;
	warn &Carp::longmess;
};

$SIG{__DIE__} = sub {
	require Carp;

	my $_ = pop @_;
	s/(.*)( at .*? line .*?\n$)/$1/s;
	push @_, $_;
	die &Carp::longmess;
};

our ($opt_v, $opt_q, $opt_p);

sub subdirlist
{
	my $list = shift;
	return join(' ', sort keys %$list);
}

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

sub parse_dump
{
	my ($inserter, $fd, $subdirs) = @_;
	my $h = {};
	my $seen = {};
	my $subdir;
	my $reset = sub {
		$h = PkgPath->handle_equivalences($inserter, $h, $subdirs);
		for my $pkgpath (values %$h) {
			create_missing_vars($pkgpath);
			my $key = $pkgpath->fullpkgpath;
			if ($pkgpath->{info}{done}) {
				print "--- $key (already done)\n";
				next;
			}
			print "+++ $key\n";
			$inserter->set_newkey($key);
			for my $var ($pkgpath->{info}->variables) {
				$inserter->add_var($var);
			}
			$pkgpath->{info}->reclaim;
			$pkgpath->{info}{done} = 1;
			$pkgpath->{info}{canonical} = $pkgpath;
			$pkgpath->{done} = 1;
			$inserter->finish_port;
		}
		$h = {};
	};

	while (<$fd>) {
		chomp;
		# kill noise
		if (m/^\=\=\=\>\s*Exiting (.*) with an error$/) {
			my $dir = PkgPath->new($1);
			$dir->break("exiting with an error");
			$h->{$dir} = $dir;
			&$reset;
			next;
		}
		if (m/^\=\=\=\>\s*(.*)/) {
			$subdir = PkgPath->new($1);
			&$reset;
		} elsif (my ($pkgpath, $var, $arch, $value) =
		    m/^(.*?)\.([A-Z][A-Z_0-9]*)(?:\-([a-z0-9]+))?\=\s*(.*)\s*$/) {
			if ($value =~ m/^\"(.*)\"$/) {
				$value = $1;
			}
			my $o = PkgPath->compose($pkgpath, $subdir);
			$h->{$o} = $o;
			# Note we did it !
			$o->{info} //= Info->new($o);
			$o->{info}->create($var, $value, $arch, $o);
		} elsif (m/^\>\>\s*Broken dependency:\s*(.*?)\s*non existent/) {
			my $dir = PkgPath->new($1);
			$dir->break("broken dependency");
			$h->{$dir} = $dir;
			&$reset;
		}
	}
	&$reset;
	$inserter->commit_to_db;
}

sub dump_dirs
{
	my ($inserter, $subdirs) = @_;
	my ($pid, $fd);
	unless (defined($pid = open($fd, "-|"))) {
		die "can't fork : $!";
	}
	if ($pid) {
		parse_dump($inserter, $fd, $subdirs);
		close $fd || die $!;
	} else {
		if (defined $subdirs) {
			$ENV{'SUBDIR'} = subdirlist($subdirs);
		}
		if ($opt_p) {
			$ENV{'REPORT_PROBLEM_LOGFILE'}= $opt_p;
		}
		$ENV{'NO_IGNORE'} = 'Yes';
		delete $ENV{'SUBPACKAGE'};
		delete $ENV{'FLAVOR'};
		exec {'make'} ("make", "dump-vars");
		die $!;
	}
}

getopts('vq:p:');
my $dbname;
if (@ARGV > 0) {
	$dbname = shift;
} else {
	$dbname = 'sqlports';
}

my $inserter = InserterList->new;

my $db = DBI->connect("dbi:SQLite:dbname=$dbname", '', '', {AutoCommit => 0});
my $db2 = DBI->connect("dbi:SQLite:dbname=$dbname-compact", '', '',
    {AutoCommit => 0});
my $normal = NormalInserter->new($db, 1000, $opt_v);
$inserter->add($normal, CompactInserter->new($db2, 1000, $opt_v));


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

dump_dirs($inserter, undef);

my $i = 1;
while (1) {
	my $subdirlist = {};
	for my $v (PkgPath->seen) {
		if (defined $v->{info}) {
			delete $v->{tried};
			if (defined $v->{want}) {
				delete $v->{want};
				if (!defined $v->{done}) {
					$v->{needalias} = 1;
				}
			}
			next;
		}
		if (defined $v->{tried}) {
		} elsif ($v->{want}) {
			$v->add_to_subdirlist($subdirlist);
			$v->{tried} = 1;
		}
	}
	last if (keys %$subdirlist) == 0;
	$i++;
	print "pass #$i\n";
	dump_dirs($inserter, $subdirlist);
}

print "Aliases\n";
for my $v (PkgPath->seen) {
	next unless defined $v->{needalias};
	my $alias = $v->{info}{canonical};
	if (defined $alias) {
		print $v->fullpkgpath, "->", $alias->fullpkgpath, "\n";
		$inserter->add_path($v->fullpkgpath, $alias->fullpkgpath);
	} else {
		print "!!! Can't figure out alias for ", $v->fullpkgpath, "\n";
	}
}

$inserter->commit_to_db;

while (my ($k, $v) = each %$Info::unknown) {
	next if $k eq 'CHECKSUM_FILE';
	print STDERR "Unknown variable $k in ", $v->fullpkgpath, "\n";
}

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