ports/databases/ports-readmes/files/make-readmes

#! /usr/bin/perl
# ex:ts=8 sw=4:
#
# Copyright (c) 2012 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.

use strict;
use warnings;
use DBI;
use Template;
use File::Path qw(make_path);
use File::Basename;
use File::Spec;
use Data::Dumper;

sub relative_url
{
	my ($a, $b) = @_;
	$a .= ".html";
	$b .= ".html";
	return File::Spec->abs2rel($a, dirname($b));
}

my $db = DBI->connect("dbi:SQLite:dbname=$ENV{DATABASE}", '', '', 
    {ReadOnly => 1});

my $outputdir = $ENV{OUTPUTDIR};
my $template = Template->new(
	{
		INCLUDE_PATH => $ENV{TEMPLATESDIR},
		OUTPUT_PATH => $outputdir,
	});


my $info_req = $db->prepare(
	qq{select
		_paths.id,
		_paths.fullpkgpath,
		_ports.comment,
		_ports.homepage,
		_descr.value,
		fullpkgname,
		permit.value
	    from _paths 
		join _Ports on _paths.id=_Ports.fullpkgpath 
		left join _Descr on _paths.id=_Descr.fullpkgpath
		join _keywords2 permit 
		    on _ports.permit_package=permit.keyref
	    order by _paths.fullpkgpath});
my ($id, $path, $comment, $homepage, $descr, $fullpkgname, $permit);
$info_req->bind_columns(\($id, $path,  $comment, $homepage, $descr, $fullpkgname, $permit));

my $dep_req = $db->prepare(
	q{select 
		_depends.type,
		_depends.fulldepends,
		t2.fullpkgpath
	from _depends 
		join _paths on _depends.dependspath=_paths.id
		join _paths t2 on _paths.canonical=t2.id
	where _depends.fullpkgpath=?
		order by _depends.fulldepends
	});
my ($type, $fulldepends, $dependspath);
$dep_req->bind_columns(\($type, $fulldepends, $dependspath));
my $multi_req = $db->prepare(
	q{select
		_ports.fullpkgname,
		t2.fullpkgpath
	    from _multi 
	    	join _paths on _multi.subpkgpath=_paths.id
		join _paths t2 on _paths.canonical=t2.id
		join _ports on _paths.canonical=_ports.fullpkgpath
	    where _multi.fullpkgpath=?
	    });
my ($multi, $subpath);
$multi_req->bind_columns(\($multi, $subpath));
my $only_for = $db->prepare(
	q{select
		_Arch.value
	    from _OnlyForArch
	    	join _Arch on _arch.keyref=_OnlyForArch.value
	    where _OnlyForArch.fullpkgpath=?
	    order by _Arch.value
	});
my $arch;
$only_for->bind_columns(\($arch));
my $not_for = $db->prepare(
	q{select
		_Arch.value
	    from _NotforArch
	    	join _Arch on _arch.keyref=_NotForArch.value
	    where _NotForArch.fullpkgpath=?
	    order by _Arch.value
	});
$not_for->bind_columns(\($arch));

my $category;
my $cat_req = $db->prepare(
	q{select
		_categorykeys.value
	    from _categories
	    	join _categorykeys on _categorykeys.keyref=_categories.value
	    where _categories.fullpkgpath=?
	    order by _categorykeys.value
	    });
$cat_req->bind_columns(\($category));

my $broken_req = $db->prepare(
	q{select
		_arch.value,
		_broken.value
	    from _broken
	    	left join _arch on _arch.keyref=_broken.arch
	    where fullpkgpath=?
	    order by _arch.value});
	
my $broken;
$broken_req->bind_columns(\($arch, $broken));

my $cat = {};

my @depends = (qw(libdepends rundepends builddepends regressdepends));

$info_req->execute;
while ($info_req->fetch) {
	print "+++$path\n";
	my $e = { path => $path,
		comment => $comment,
		homepage => $homepage,
		descr => $descr,
		fullpkgname => $fullpkgname };
	unless ($permit =~ /yes/i) {
		$e->{permitp} = $permit;
	}
	$dep_req->execute($id);
	while ($dep_req->fetch) {
		push(@{$e->{$depends[$type]}},
		    {
			depends => $fulldepends,
			url => relative_url($dependspath, $e->{path})
		    });
	}

	$broken_req->execute($id);
	while ($broken_req->fetch) {
		push (@{$e->{broken}}, 
		    {
			arch => $arch,
			text => $broken
		    });
	}
	$only_for->execute($id);
	while ($only_for->fetch) {
		push (@{$e->{only_for}}, $arch);
	}
	$not_for->execute($id);
	while ($not_for->fetch) {
		push (@{$e->{not_for}}, $arch);
	}
	$multi_req->execute($id);
	while ($multi_req->fetch) {
		push @{$e->{multi}},
		    {
			name => $multi,
			url => relative_url($subpath, $e->{path})
		    };
	}

	$cat_req->execute($id);
	while ($cat_req->fetch) {
		push @{$e->{category}},
		    {
		    	name => $category, 
			url => relative_url("cat/$category", "path/$e->{path}")
		    };
		$cat->{$category}{$e->{fullpkgname}} = $e->{path};
	}
	$template->process('port.tt2', $e, "path/$e->{path}.html") or die;
}

print "Generating category indexes\n";
while (my ($c, $h) = each %$cat) {
	my $e = { category => $c};
	for my $pkgname (sort keys %$h) {
		my $p = $h->{$pkgname};
		push @{$e->{ports}},
		    {
			name => $pkgname,
			url => relative_url("path/$p", "cat/$c")
		    };
	}
	$template->process('category.tt2', $e, "cat/$c.html") or die;
}

print "Generating main index\n";
my $e = {};
for my $c (sort keys %$cat) {
	push @{$e->{categories}},
	    {
	    	name => $c,
		url => "cat/$c.html"
	    };
}
$template->process('main.tt2', $e, "index.html") or die;