#!/usr/bin/env perl
#
# $NetBSD: act2html.pl,v 1.11 2007/07/31 13:45:38 kano Exp $
# <!-- Based on english version: -->
# <!-- NetBSD: act2html.pl,v 1.11 2007/07/31 13:45:38 kano Exp   -->
# Process index.act file into index.html for the in-Action
# gallery.  Customized version of DKBrownlee's list2html.pl.
#
# Tags: 
#       <PORTPAGE>name          Link to port home page
#       <([-\w.]+@[-\w.]+)>     -> email address        eg: <user@host>
#       <PKGSRC>category/name   -> link to pkgsrc README.html
#       <CURRENTSRC>path        -> link to source file/dir in -current
#
#	([a-zA-Z_][-\w.+]*[\w+])\((\d)(|\.(\w+))(|\+(\W+))\)
#		-> man pages:   Default collection is NetBSD-current.
#				Available collections are "1.3.3",
#				"1.4.3", "1.5", "current"
#
#				Usage examples: ls(1), ls(1.i386)
#				    ls(1+1.4.3), ls(1.i386+1.4.3)

use strict;
use Getopt::Std;
$^W=1;
my($verbose,%extras,$months_previous);
my($version,%opt,%pkgname);

# List of pkgsrc names to 'human preferred' forms
%pkgname = qw(kde KDE gimp GIMP gnome GNOME xsane XSane);

$months_previous=9;	# previous months to display for DATE entries

$version='$Revision: 1.11 $';
$version =~ /([\d.]+)/ && ($version=$1);

if (!&getopts('a:c:m:hV',\%opt) || $opt{'h'} || ( !$opt{'V'} && @ARGV != 2) )

    {
    print "act2html.pl [opts] infile outfile
[opts]	-a xxx	Define 'arch=xxx' when linking to manpages
	-c xxx  Define 'collection=xxx' when linking to manpages
	-h	This help.
	-V	Display version and exit ($version - David Brownlee/abs)

act2html.pl processes the index.act file into index.html for the in-Action
gallery.  It is a customized version of David Brownlee's list2html.pl.
";
    exit;
    }
if ($opt{'V'})
    { print "$version\n"; exit; }

$verbose=1;

%extras=(

'<TOPACTION','<td bgcolor="#000000"><img src="../../../images/empty.gif" width="1" height="1" alt=" "></td>
<td bgcolor="#000000"><img src="../../../images/empty.gif" width="1" height="1" alt=" "></td>
<td bgcolor="#000000"><img src="../../../images/empty.gif" width="1" height="1" alt=" "></td>
<td bgcolor="#d8d8d8"><img src="../../../images/empty.gif" width="1" height="1" alt=" "></td>
<td bgcolor="#d8d8d8"><img src="../../../images/empty.gif" width="1" height="1" alt=" "></td>'

);

# XXX Should DTRT with faqs not under Documentation

&makeact(@ARGV,&extras_generate(%extras));
exit;

sub extract_tags
    {
    my($file,@tags)=@_;
    my($tag,%map);

    if (!open(FILE,$file))
	{ return; }
    while (<FILE>)
	{
	foreach $tag (@tags)
	    {
	    if ( /($tag)/ )
		{ $map{$tag}=$1; }
	    }
	}
    close(FILE);
    %map;
    }

sub extras_generate
    {
    my(%extras)=@_;
    my($pathtodoc,$str);

    if ($0 !~ m#(.*)/[^/]+.pl#)
        { &fail("Unable to extract path from '$0'"); }
    $pathtodoc="$1/docs";
    foreach $str ( keys %extras )
        {
        $extras{$str} =~ s#\$HOME#$pathtodoc/..#g;
        $extras{$str} =~ s#\$DOCUMENTATION#$pathtodoc#g;
        }
    (%extras);
    }

sub extras_process
    {
    my($data,%extras)=@_;
    my($key,$title,$value);

    foreach $key ( keys %extras )
	{
	$value=$extras{$key};
	if ($data =~ /$key/)
	    {
	    if (defined($1))
		{
		$title=$1;
		$value=~s#\$TITLE#$title#g;
		}
	    $data=~s/$key.*/$value/;
	    }
	}
    $data;
    }

sub fail
    {
    print STDERR "ABORTING: ",@_,"\n";
    exit 3
    }

# Collect $act containing forward links as we go. In general each entry will
# generate something in $act and some expanded data in the main $data.
#
sub makeact
    {
    my($infile,$outfile,%extras)=@_;
    my($data,$section,$href,$header,$act,$pre,%tags,$date_month);
    my($date_num,$date_num_used,$entry_num,$ignore,$in_entry,$in_section);
    my($endact);
    my($title_font) = "";
    my($end_title_font) = "";
    my(%rcsmap)=&extract_tags($outfile,'\$NetBSD.*\$');
    my($rcstag);

    $act='';

    $data=$date_month='';
    $entry_num=$date_num=$date_num_used=0;
    open(FILE,$infile) || die("Unable to open '$infile': $!");
    foreach( <FILE> )
	{
	foreach $rcstag (%rcsmap)
	    { s/$rcstag/$rcsmap{$rcstag}/; }
	if (defined($pre))		# Handle continuation lines
	    { $_=$pre.$_; $pre=undef; }

	if (substr($_,-2) eq "\\\n")	# Handle continuation lines
	    {
	    s/\\\n$//;
	    $pre=$_;
	    next;
	    }

	if (! $ignore)
	    { $data.=&sub_external_links($_); }
	}

    close(FILE);
    $act.="\n";
    $_="\n\n<!-- DO NOT EDIT THIS FILE. VIEW 'README' FOR INSTRUCTIONS -->\n";
    if ($data !~ s/(<head[^>]*>)/$1$_/i)
	{ &fail("Unable to locate <head> tag"); }

    open(FILE,"|cat >$outfile") || die("Unable to write '$outfile': $!");
    print FILE &extras_process($data,%extras);
    close(FILE);
    if ($date_num)
	{
	print "$date_num date entr",($date_num==1)?'y':'ies';
	if ($date_num_used != $date_num)
	    { print " ($date_num_used used)"; }
	print ".\n";
	}
    if ($entry_num)
	{ print "$entry_num entr",($entry_num==1)?'y':'ies',".\n"; }
    }


sub sub_external_links
    {
    my($text) = @_;

    # Man page references. As of 1.4 matches every page except '[' and 'w'.
    # 
    $_ = $text; # Output text include match string, so handle in sections
    $text = '';
    while ( m#([a-zA-Z_][-\w.+]*[\w+])\((\d)(|\.(\w+))(|\+(\W+))\)# )
        {
        my($page, $section, $arch, $collection) = ($1, $2, $4, $6);
        my($link);

        $link = 'http://man.NetBSD.org/man/';

        $link .= "$page+$section";

        if (defined($arch))
            { $link .= ".$arch"; }
        elsif ($opt{'a'})
            { $link .= ".$opt{'a'}"; }

        if (defined($collection))
            { $link .= "+NetBSD-$collection"; }
        elsif ($opt{'c'})
            { $link .= "+$opt{'c'}"; }
        else
            { $link .= "+NetBSD-current"; }

        $text .= $` . "<a href=\"$link\">$page($section)</a>";
        $_ = $';
        }
    $text .= $_;

    # Expand <CURRENTSRC>path
    #
    if ($text =~ m#<CURRENTSRC>([^\s<>]+\w)#)
	{
        my($path);

	$path = $1;
	$path =~ s#^/##;
	$path =~ s#^usr/##;
	$path =~ s#^src/##;
	if ($path =~ m#^(sys|share|gnu)#)
	    { $path = $1."src/$path"; }
	elsif ($path !~ m#^(doc|xsrc)#)
	    { $path = "basesrc/$path"; }
	$text =~ s#<CURRENTSRC>([^\s<>]+\w)#<a href="http://cvsweb.NetBSD.org/bsdweb.cgi/$path?rev=HEAD&content-type=text/x-cvsweb-markup">$1</a>#;
	}

    # Expand <PKGSRC>category/name entries
    #
    while ( $text =~ m#<PKGSRC>(([-\w.]+/|)([-\w_.+]+[\w+]))#)
	{
        my($n) = $3;
	if (defined($pkgname{$n}))
	    { $n = $pkgname{$n}; }
        $text =~ s#<PKGSRC>(([-\w.]+/|)([-\w_.+]+[\w+]))#<a href="ftp://ftp.NetBSD.org/pub/pkgsrc/current/pkgsrc/$1/README.html">$n</a>#;
	}

    # Expand <PORTPAGE>portname entries
    $text =~ s#<PORTPAGE>([^\s<]+[^<\s.]+\w)#<a href="../../ports/$1/">NetBSD/$1</a>#g;

    # Expand <user@host> email addresses
    #
    $text =~ s#<([-\w.]+@[-\w.]+)>#<a href="mailto:$1">&lt;$1&gt;</a>#g;

    $text;
    }

sub verbose
    { $verbose && print @_; }

sub warn
    { print "WARNING: ",@_; }