#!/usr/bin/perl

################################################################################
#
# Copyright 2001, 2002 Benjamin Lutz, <mail@maxlor.com>
#
# makesubindex.pl - written on 2001-09-25
#                 - last update: 2002-10-24
#
# Parses /usr/ports/INDEX and creates an index file containing
# a ports name, its directory and its description. /usr/ports/index
# will contain this information for all ports, and there's a
# /usr/ports/<category>/index containing only the ports in the
# respective category.
#
# If your ports dir is not /usr/ports, edit the $portsdir variable
# below. If you wish to not generate an index file for certain
# categories, or if you have other special directories in your ports
# dir, add them to the %exclude hash below.
#
# Oh yeah, in case this isn't obvious - to run this script you'll need
# write access to the ports tree.
#
# ----- License START -----
#
# Redistribution, use (in source and binary form) and modification of this
# script are permitted provided that the following conditions are met:
# 1. Redistributions of this script must contain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
# AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
# AUTHOR OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
# SPECIAL, EXEMPLARY OR CONSEQUENTAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
# PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA OR PROFITS;
# OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
# WHETHER IN CONTRACT, STRICT LIABILITY OR TORT (INCLUDING NEGLIGENCE OR
# OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
# ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
# ----- License END -----
#
################################################################################

my %exclude = (
	Mk => 1,
	Templates => 1,
	Tools => 1,
	distfiles => 1
	);

my $portsdir = '/usr/ports';

my $indexfile = 'INDEX-5';

################################################################################
# Don't venture below if you don't know Perl.
################################################################################


use strict;
use Fcntl ':flock';

my @categories;
my @line;

&GenerateCategories;
&ReadINDEX;
foreach my $category (@categories) {
	&Createindex($category)
}
&Createindex();		# Create main index

sub GenerateCategories {

	print "Generating category list... ";

	opendir(DIR, $portsdir) or die "Cannot open dir $portsdir: $!\n";
	while ($_ = readdir(DIR)) {
		next unless (-d "$_");
		next if $_ =~ /^\./;
		next if $exclude{$_};

		push @categories, $_;
	}
	closedir DIR;

	print "done\n";
}

sub ReadINDEX {

	print "Reading INDEX... ";

	open FILE, "$portsdir/$indexfile";

	while ($_ = <FILE>) {
		my @thisline = split /\|/, $_;

		$thisline[1] =~ s/$portsdir\/(.*)/$1/e;
		$thisline[0] =~ s/(.*)-(.*)/$1/;

		push @line, { name => $thisline[0],
			version => $2,
			description => $thisline[3],
			category => $thisline[6],
			path => $thisline[1] };
	}

	close FILE;

	print "done\n";
}

sub Createindex {

	my $category = shift;

	if ($category) { print "Creating index for category $category... " }
	else { print "Creating main index... " }

	my @output;

	foreach my $thisline (@line) {
		next unless (not $category or
			$thisline->{category} =~ m/^$category$/i or
			$thisline->{category} =~ m/^$category\s/i or
			$thisline->{category} =~ m/\s$category$/i or
			$thisline->{category} =~ m/\s$category\s/i);

		push @output, sprintf "%-15s %-22s %s\n", $thisline->{name}, $thisline->{path}, $thisline->{description};
	}

	@output = sort {lc($a) cmp lc($b)} @output;

	open(FILE, ">$portsdir/$category/index") or print "Error: Cannot write to file $portsdir/$category/index: $! ";
	flock(FILE, LOCK_EX) or print "Error: Cannot get a lock on file $portsdir/$category/index: $! ";
	print FILE @output;
	flock(FILE, LOCK_UN);
	close FILE;
	
	print "done\n";
}