#!/usr/bin/perl -w

# convert a ports INDEX file to SGML files
#
# by John Fieber <jfieber@FreeBSD.org>
# Mon May 13 10:31:58 EST 1996
# $FreeBSD$

############################################################

use strict;
use POSIX;
use IO::File;

my $base = "";
my $baseHTTP = "";
my $urlcgi = "";
my $packagesURL = "";
my $today = getdate();
my %p = ();

# Load local config file. You can override in portindex.conf
# the variables for the default web and the ftp server. This
# make it easy to maintain a local web mirror and let the
# URL point to yourself and not to the standard FreeBSD FTP server.

my $config = $0 . '.' . 'conf';
do $config if -f $config;

# This is the base of where we ftp stuff from
my $ftpserver;
if ($ENV{'MASTER_FTP_SERVER'}) {
    $ftpserver = $ENV{'MASTER_FTP_SERVER'};
} else {
    $ftpserver = 'ftp://ftp.FreeBSD.org' if !$ftpserver;
}
$baseHTTP = $base if !$baseHTTP;
my $baseFTP = "$ftpserver/pub/FreeBSD/ports/ports";
my $baseCVSWEB = 'http://www.FreeBSD.org/cgi/cvsweb.cgi/';
$urlcgi = 'http://www.FreeBSD.org/cgi/url.cgi' if !$urlcgi;
$packagesURL = "$ftpserver/pub/FreeBSD/ports/i386/packages-stable/All/"
    if !$packagesURL;
# support tar on the fly or gzip'ed tar on the fly
my $ftparchive = '';
$ftparchive = 'tar' if !defined $ftparchive;


# ports download sources script
my $pds = 'http://www.FreeBSD.org/cgi/pds.cgi';

# better layout and link to the sources
if ($urlcgi) {
    $baseHTTP = $urlcgi . '?' . $baseHTTP;
}

my %packages = ();
my %category_description = ();
my @category_groups = ();
my %category_groups = ();
packages_exist('packages.exists');
category_description(($ARGV[1] || '.') . '/categories' );
category_groups(($ARGV[1] || '.') . '/categories.descriptions' );
main();

sub getdate {
    return POSIX::strftime("Last modified: %d-%B-%Y",localtime);
}

sub header {
    my $fh = shift;
    my $htext = shift;
    #local($fh, $htext) = @_;
    print $fh <<EOF;
<!DOCTYPE html PUBLIC "-//FreeBSD//DTD HTML 4.01 Transitional-Based Extension//EN" [
<!ENTITY base CDATA '..'>
<!ENTITY date  "<em>$today</em>">
<!ENTITY title '$htext'>
<!ENTITY % navinclude.ports "INCLUDE">
<!ENTITY % ports.ent SYSTEM "ports.ent">
%ports.ent;
<!ENTITY email 'ports'>
%statistics.ent;
]>
<html>&header;

&searchform;

<hr>

EOF
}

sub footer {
    my $fh = shift;
    my $ftext = shift;
    #local ($fh, $ftext) = @_;
print $fh <<EOF;

$ftext
&footer;
</BODY>
</HTML>
EOF
}

sub packages_exist {
    my $file=shift;
    my %p;
    #local($file, *p) = @_;

    open(P, $file) || do {
	warn "open $file: $!\n";
	warn "Cannot create packages links\n";
	return 1;
    };

    while(<P>) {
	chop;
	$packages{$_} = 1;
    }
    close P;
}

sub category_description {
    my $file = shift;

    open(P, $file) || do {
	warn "open $file: $!\n";
	warn "Cannot find category description\n";
	return 1;
    };

    while(<P>) {
	# ignore comments
	next if /^\s*#/;
	if (/^\s*([^,]+),\s*"([^"]+)",\s*([A-Z]+)/) {
	    $category_description{$1}{desc}=$2;
	    $category_description{$1}{group}=$3;
	}
    }
    close P;
}

sub category_groups {
    my $file = shift;

    open(P, $file) || do {
	warn "open $file: $!\n";
	warn "Cannot find category groups\n";
	return 1;
    };

    while(<P>) {
	# ignore comments
	next if /^\s*#/;
	if (/^\s*([^,]+),\s*(.+)/) {
	    $category_groups{$1}=$2;
	    push(@category_groups,$1);
	}
    }
    close P;
}

sub main {
    my @master=();
    my %stats;
    my %catkey;
    my %data;
    my $portnumber = 0;

    my $sep = "<B>:</B>";

    my $moutf = new IO::File;
    my $outf = new IO::File;
    my $mindex = new IO::File;
    my $statistics = new IO::File;

    open(INDEX, $ARGV[0]);
    $portnumber = "0";
    while (<INDEX>) {
	chop;
	s/&/&amp;/g;
    	s/</&lt;/g;
    	s/>/&gt;/g;

    	# Read a record
	my ($name, $loc, $prefix, $desc, $ldesc, $owner, $cats, 
	    $bdep, $rdep, $www) = split('\|');

	# Check for double hyphens in the name (--).
	$name =~ s/--/-/g;

    	# Split the categories into an array
	my @cat = split("[ \t]+", $cats);

    	$catkey{$name} = $cat[0];

	my $sourcepath = $loc;
	$sourcepath =~ s%/usr/%%;
	
	foreach my $i (sort(@cat)) {
	    $stats{$i}++;

	    # figure out the FTP url
	    $loc =~ s/\/usr\//$baseCVSWEB/;
	    $ldesc =~ s/\/usr\//$baseHTTP/;

	    # The name description and maintainer
	    $data{$i} .= "<DT><B><A NAME=\"$name\"></A><A HREF=\"$loc$ftparchive\">$name</A></B> ";
     

	    $data{$i} .= "<DD>$desc<BR><A HREF=\"$ldesc\">Long description</A>";
	    if ($packages{"$name.tbz"}) { 
		$data{$i} .= qq{ | <a href="$packagesURL$name.tbz">Package</a>};
	    } elsif ($packages{"$name.tgz"}) { 
		$data{$i} .= qq{ | <a href="$packagesURL$name.tgz">Package</a>};
	    }

	    $data{$i} .= qq{ | <A HREF="$pds?$sourcepath">Sources</A>};

	    if ($www ne "") {
		$data{$i} .= qq{ | <a href="$www">Main Web Site</a>};
	    }

	    my $ownerurl = $owner;
	    $ownerurl =~ s/&lt;/</g;
	    $ownerurl =~ s/&gt;/>/g;
	    $data{$i} .= 
		"<BR><I>Maintained by:</I> <A HREF=\"mailto:$ownerurl\">$owner</A>";

	    # If there are any dependencies, list them
	    if ($bdep ne "" || $rdep ne "") {
		$data{$i} .= "<BR><I>Requires:</I> ";
		my @dep = split(/ /, "$bdep $rdep");
		my $last = '';
		foreach my $j (sort @dep) {
		    next if $j eq $last;
		    $last = $j;
		    $data{$i} .= " <A HREF=\"##$j##.html#$j\">$j</A>,";
		}
		# remove the trailing comma
		chop $data{$i};
	    }

	    # If the port is listed in more than one category, throw
	    # in some cross references
	    if ($#cat > 0) {
		$data{$i} .= "<BR><EM>Also listed in:</EM> ";
		foreach my $j (@cat) {
		    if ($j ne $i) {
			if ($j eq $cat[0]) {
			    $data{$i} .= " <STRONG><A HREF=\"$j.html#$name\">\u$j</A></STRONG>,";
			}
			else {
			    $data{$i} .= " <A HREF=\"$j.html#$name\">\u$j</A>,";
			}
		    }
		}
		# remove the trailing comma
		chop($data{$i});
	    }
	    $data{$i} .= "<P></P></DD>\n"
	}

    	# Add an entry to the master index

	# workaround for SGML bug, `--' is not allowed in comments
	my $sname = $name; 
	$sname =~ s/--/-=/g;
    	$master[$portnumber] = 
    	    "<!-- $sname --><STRONG><A HREF=\"$cat[0].html#$name\">$name</A></STRONG> " .
    	    " -- <EM>$desc</EM><BR>\n";
	$portnumber++;
    }

    # create categories-grouped.sgml and <category>.sgml

    $moutf->open(">categories-grouped.sgml");
    header($moutf, "FreeBSD Ports Categories Listed By Groups");

    print $moutf <<EOF;
<A NAME=\"top\"></A>
EOF

    if ($portnumber eq '0') {
      print $moutf "<P>none found</P>\n";
    } else {
    foreach my $cg (@category_groups) {
	print $moutf "<H3>",$category_groups{$cg},"</H3>\n";
	print $moutf "<UL>\n";
	foreach my $key (sort(keys(%stats))) {
	    next if ($category_description{$key}{group} ne $cg);
	    # For the master file...
	    print $moutf 
		"<LI><A HREF=\"$key.html\">\u$key</A> <em>($stats{$key})</em>";
	    if ($category_description{$key}{desc}) {
		print $moutf " -- " . $category_description{$key}{desc};
	    }

	    # Someone forgot to add a category to the description file
	    # or there is a typo in the category field.
	    else {
		warn "No description found for category: ``$key''!\n";
		warn "Please fix me or send an E-Mail to doc\@FreeBSD.org\a\n";
		sleep(3);
	    }
	    print $moutf "</LI>\n";

	    # Create the category file
	    $outf->open(">$key.sgml");
	    header($outf, "FreeBSD Ports: \u$key");
	    if ($category_description{$key}{desc}) {
		print $outf "<h3>", $category_description{$key}{desc}, "</h3>\n";
	    }
	    print $outf "<DL>\n";
	    my $d = join("\n", sort(split(/\n/, $data{$key})));
	    $d =~ s/##([^#]*)##/$catkey{$1}/g;
	    print $outf $d;
	    print $outf "</DL>\n";
	    footer($outf, "<p></p><A HREF=\"#top\">top</A>" .
		" -- <A HREF=\"master-index.html\">Index</A>");
	    $outf->close;
	}
	print $moutf "</UL>\n";
    }
    }

    footer($moutf, "");
    $moutf->close;

    # create categories-alpha.sgml

    $moutf->open(">categories-alpha.sgml");
    header($moutf, "FreeBSD Ports Categories Listed Alphabetically");

    print $moutf <<EOF;
<A NAME=\"top\"></A>
EOF

    if ($portnumber eq '0') {
      print $moutf "<P>none found</P>\n";
    } else {
      print $moutf "<UL>\n";
      foreach my $key (sort(keys(%stats))) {
	print $moutf
	  "<LI><A HREF=\"$key.html\">\u$key</A> <em>($stats{$key})</em>";
	if ($category_description{$key}{desc}) {
	  print $moutf " -- " . $category_description{$key}{desc};
	print $moutf "</LI>\n";
	}
      }
      print $moutf "</UL>\n";
    }

    footer($moutf, "");
    $moutf->close;

    # Create master-index.sgml

    $mindex->open(">master-index.sgml");
    header($mindex, "FreeBSD Ports Collection Index");
    print $mindex "<P>\n";
    print $mindex sort @master;
    print $mindex "</P>";
    footer($mindex, "<A HREF=\"#top\">top</A>");
    $mindex->close;

    # Create statistics.ent

    $statistics->open(">statistics.ent");

    # doesn't seem to work:
    # print $statistics "<!ENTITY date '<em>$today</em>'>\n";

    my $ptgzsize = `cat ports.size 2>/dev/null` || "";
    if ($ptgzsize =~ /^\d+$/) {
       $ptgzsize = sprintf("%.0f", $ptgzsize/(1024*1024));
       print $statistics "<!ENTITY ports.size 'about $ptgzsize megabytes'>\n";
    } else {
       warn "Unknown size for ports.tar.gz\n";
       print $statistics "<!ENTITY ports.size 'several tens of megabytes'>\n";
    }
    print $statistics "<!ENTITY ports.count '$portnumber'>\n";

    $statistics->close;
    close(INDEX);
}
