#!/usr/bin/perl
# vim:ft=perl:cindent:ts=8:fdm=marker:cms=\ #\ %s
#
#    dwww-build-menu - create Debian Documentation Menu
#    Copyright (C) 2003 Robert Luberda <robert@debian.org>
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
#
# $Id: dwww-build-menu 513 2009-01-11 12:36:27Z robert $
#

use strict;

use Debian::Dwww::Utils;
use Debian::Dwww::DocBase;
use Debian::Dwww::Common;
use Debian::Dwww::Initialize;
use File::Path qw/mkpath rmtree/;
use File::Temp 'tempdir';

my $dwwwconf 		= &DwwwInitialize("/etc/dwww/dwww.conf");

my $out_dir    		= $dwwwconf->{'DWWW_DOCROOTDIR'} . "/dwww/menu";
my $out_dir_tmp  	= tempdir('dwww-build-menu.XXXXXX', 
			           DIR =>  $dwwwconf->{'DWWW_TMPDIR'},
				   CLEANUP => 1) . "/menu.temp.$$";
my $title    		= $dwwwconf->{'DWWW_TITLE'};
my $dwww_regdocs_cache 	= $dwwwconf->{'DWWW_REGDOCS_DB'};
my $dwww_db2pkg_cache 	= $dwwwconf->{'DWWW_DOCBASE2PKG_DB'};
$dwww_regdocs_cache 	= undef if "$dwww_regdocs_cache" eq "";
$dwww_db2pkg_cache	= undef if "$dwww_db2pkg_cache" eq "" and not ( -r "$dwww_db2pkg_cache" );


undef %{$dwwwconf};

my $templates_dir		= "/usr/share/dwww/templates";
my $template_single_start	= "$templates_dir/menu.single.start";
my $template_single_end		= "$templates_dir/menu.end";
my $template_all_start		= "$templates_dir/menu.all.start";
my $template_all_end		= "$templates_dir/menu.end";
my $template_error_start	= "$templates_dir/menu.errors.start";
my $template_error_end		= "$templates_dir/menu.errors.end";
my $template_nosections		= "$templates_dir/menu.nosections";

my $single_index = 'one';
my $all_index    = 'all';

my @known_formats=(
	'html',
	'info',
	'text',
	'rtf',
	'debiandoc-sgml',
	'docbook-xml',
	'dvi',
	'latex',
	'linuxdoc-sgml',
	'pdf',
	'postscript',
	'ps',
	'sgml',
	'tar',
	'texinfo',
	'dwww-url' # internal dwww's format
	);


my %sections      =  ();
my %section_names = (); # real names of sections
my %node_section  = (); # is node section ?
my %map_section   = (); # for section without docs, the nearest section with docs
my %doc_list      = (); # list of documents
my %files         = (); # list of files
my %dbfile2pkg    = (); # maps doc-base file names to package names (filled by ReadDocb2PkgCache)


my $opt_verbose   = 0;
my $opt_debug     = 0;

umask 022;
&mkpath($out_dir_tmp) or die "Can't create directory $out_dir_tmp: $!\n";

open ERRFILE , ">$out_dir_tmp/errors.html" or &CleanAndDie("Can't create file errros.html: $!");
print ERRFILE &TemplateFile($template_error_start, { 'TITLE'       => &HTMLEncode($title) });
$ErrorProc = \&ErrorHandle;

&ParseDocDir("/var/lib/doc-base/documents");

&FindMapSections;


&ReadDocb2PkgCache;
&BuildMenus;

&CreateIndex;


&rmtree($out_dir);
&RenameDir($out_dir_tmp, $out_dir);

print ERRFILE &TemplateFile($template_error_end, {});
close ERRFILE;
exit (0);

#########################################################################
#
# Local functions
#
sub CleanAndDie { # {{{
	my $msg = shift;
	die "$msg";
	exit(1);
} # }}}

my $last_err_file = '';

## ErrorHandle($file, $message)
sub ErrorHandle { # {{{
	my $file = shift;
	my $msg  = shift;

	print ERRFILE "<dt><br></dt>\n" unless $last_err_file eq $file;
	print ERRFILE "<dt><a href=\"file://" . &URLEncode($file)  . "\">"
			. &HTMLEncode($file) . "</a></dt>\n";
	print ERRFILE "<dd>" . &HTMLEncode($msg) . "</dd>\n";
	$last_err_file = $file;
} # }}}

sub ParseDocDir { # {{{
        my $dir = shift;

        if (not (opendir DOCBASEDIR, $dir)) {
                print STDERR "Can't open directory $dir: $!\n" if $opt_verbose;
                return;
        }

        while (my $f = readdir(DOCBASEDIR))
        {
		next if $f =~ /^\./;
		next if -d $f;

                if (defined (my $entry = &ParseDocBaseFile("$dir/$f"))) {
                        &AddNewEntry("$dir/$f", $entry);
			undef %{$entry};
                }
        }

} # }}}


sub ReadDocb2PkgCache { # {{{
	return unless defined $dwww_db2pkg_cache;
	return unless open CACHE, "<$dwww_db2pkg_cache";
	while (<CACHE>) {
		chomp();
		my ($docb_file, $pkg) 	= split (/\001/, $_, 2);
		$dbfile2pkg{$docb_file} = $pkg;
	}
	close CACHE;
} # }}}

# Adds %entry to @documents
sub AddNewEntry() { # {{{
        my $file = shift;
	my $entry = shift;
	my $doc_entry = { };
        my $known = 0;
	my $sec   = undef;

	if (exists $entry->{'dwww-section'}) {
		&DwwwSection2Section($entry);
	}

        if (defined $entry->{'document'}) {
                $doc_entry->{'document'} = $entry->{'document'};
	}

        if ((not defined $entry->{'title'}) or $entry->{'title'} =~ m/^\s*$/) {
                &ErrorHandle($file,"No (or empty) title!");
                $doc_entry->{'title'} = "(No title)";
        } else {
		$doc_entry->{'title'} = $entry->{'title'};
	}


        if ((not defined $entry->{'abstract'}) or $entry->{'abstract'} =~ m/^\s*$/) {
                &ErrorHandle($file, "Warning: no (or empty) abstract!");
                $doc_entry->{'abstract'} = "";
        } else {
		$doc_entry->{'abstract'} = $entry->{'abstract'}
	}

        if ((not defined ($sec = $entry->{'section'})) or $sec =~ m/^\s*$/)
        {
                &ErrorHandle($file, "No (or empty) section!");
                $sec = 'unknown';
        }

        foreach my $f (@known_formats) {
		my $w;
                if (defined ( $w = $entry->{'formats'}->{$f}->{'index'})
		     or defined ($w = $entry->{'formats'}->{$f}->{'files'})) {
                        if (exists $files{$w})
                        {
                		&ErrorHandle($file, "File already known: \"$w\"");
                                return;
                        }

                        if ( $f eq 'dwww-url' or -r $w) {
                                $files{$w} = '1';
				$doc_entry->{'frm_name_' . $known} = $f;
				$doc_entry->{'frm_file_' . $known} = $w;
                                $known++;
                        } else {
                		&ErrorHandle($file, "Can't read \"$w\": $!");
                        }

                }
        }
        if ($known == 0 ) {
                &ErrorHandle($file, "No known formats!");
                return;
        }

	$sec = &AddCanonSection($sec);
	$doc_entry->{'section'} = $sec;
        $doc_entry->{'frm_count'} = $known;

	push(@{$doc_list{$sec}}, $doc_entry);

} # }}}

sub sort_documents { # {{{
	my $res;

        $res = $a->{'section'} cmp $b->{'section'};

        $res = lc $a->{'title'} cmp lc $b->{'title'} if $res == 0;

        return $res;
} # }}}

sub AddCanonSection ($) { # {{{
        my $arg  = shift;
        my $sec  = '';
        my $nsec = '';
	my $prev = '';

        foreach my $s (split /\/+/, $arg) {
                $sec 	.= '/' unless $sec eq '';
                $nsec 	.= '/' unless $nsec eq '';
                $sec 	.= lc $s;
		$nsec 	.= ucfirst $s;
                $sections{$sec} 	= 0 unless exists $sections{$sec};
		$section_names{$sec} 	= $nsec;
		$node_section{$prev}    = 1 unless $prev eq '';
		$prev    = $sec;
        }

        $sections{$sec}++;
        return $sec;

} # }}}


sub FindMapSections() { # {{{
	my @ss = sort keys %sections;
	undef %map_section;

        for (my $i=$#ss; $i >= 0; $i--) {
		my $sec = $ss[$i];
		if ($sections{$ss[$i]} == 0)
		{
			for (my $j = $i; $j <= $#ss; $j++){
				if( exists $map_section{$ss[$j]})
				{
					$map_section{$sec} = $map_section{$ss[$j]};
					last;
				}
			}
		}
		else
		{
			$map_section{$sec} = $sec;
		}
	}
} # }}}

sub SectionToFileName() { # {{{
	$_    = shift;
	my $type = shift;

	$_ = $map_section{$_};
	s/\//_/g;
	return "s$_.html" if ($type eq $single_index);
	return "$_";
} # }}}


sub SectionsToHTML() { # {{{
        my $cur_sec = shift;
	my $type  = shift;
        my $depth = 0;
        my $pr_depth = -1;
	my $res = '';
	my $cur_depth = ($cur_sec =~ s;/;/;g) + 0;
	my %override_node_section = {};

	my $sec = "";
        foreach my $s (split /\/+/, $cur_sec) {
                $sec 	.= $s;
		$override_node_section{$sec} = 1;
                $sec 	.= '/';
	}

        foreach my $s (sort keys %sections) {
                $depth = ($s =~ s;/;/;g) + 0;
		my $ps = $s;
		$ps =~ s/[^\/]+$//;

		next unless ($type eq $all_index or $ps eq '' or index($cur_sec .'/', $ps) == 0);

                &CleanAndDie('Internal error') if ($depth > $pr_depth + 1);
                $res .= "<ul>\n" if ($depth > $pr_depth);

                while ($pr_depth > $depth) {
                        $res .= "</ul>\n";
                        $pr_depth--;
                }
                $pr_depth = $depth;
		my $ns = $section_names{$s};
		$ns =~ s|^.*/||g;
		$ns .= "&nbsp;..." if ($type ne "all"
				   	and exists $node_section{$s}
					and not exists $override_node_section{$s});

                if ($s eq $cur_sec) {
                        $res .= "<li><strong>$ns</strong>\n";
                } elsif ($type eq $single_index and ($sections{$s} > 0 or index($cur_sec, $s .'/') != 0 )){
                        $res .= "<li><a href=\"" . &SectionToFileName($s, $type) . "\">$ns</a>\n";
                } elsif ($sections{$s} > 0 and $type eq $all_index) {
			my $slink = &SectionToFileName($s, $type);
                        $res .= "<li><a href=\"#" . $slink . "\" name=\"m" . $slink . "\">$ns</a>\n";
                } else {
                        $res .= "<li>$ns\n";
                }

        }

        while ($pr_depth > -1) {
                $res .= "</ul>\n";
                $pr_depth--;
        }

	return $res;

} # }}}




sub DocumentToHTML($) { # {{{
	my $doc = shift; # reference to hash
	my $res = '';
	my $pkg = undef;

	if (exists $doc->{'document'}) {
		# TODO: document could be generated from more than one control file
		#       we really should support this
		$pkg = $dbfile2pkg{ $doc->{'document'} };
	}

	$res .= "<dt>";
	$res .= "<a href=\"" . &GetURL($doc->{'frm_name_0'}, $doc->{'frm_file_0'}) . "\"";
	$res .= " name=\"" . &HTMLEncode($doc->{'document'}) . "\""
	       if defined ($doc->{'document'});
	$res .= ">" . &HTMLEncode($doc->{'title'}) . "</a>\n";

	if (defined $pkg) {
		$res .= "&nbsp; <small><em>(package: <a href=\"" . &GetURL('pkgsearch', $pkg);
		$res .= "\">" . &HTMLEncode($pkg) . "</a>)";
		$res .= "</em></small>\n";
	}

	$res .= "</dt>\n";
	$res .= "<dd>" . &HTMLEncodeAbstract($doc->{'abstract'});
	if ($doc->{'frm_count'} > 1) {
		$res .= "\n<br><b>Formats:</b> ";
		for (my $i=0; $i < $doc->{'frm_count'}; $i++) {
			my $f="frm_name_$i";
			my $g="frm_file_$i";
			$res .= "[<a href=\"" . &GetURL($doc->{$f}, $doc->{$g});
			$res .= "\">" . $doc->{$f} . "</a>] ";
		}

	}


	$res .= "</dd>\n";
	$res .= "<dt><br></dt>\n";
	return $res;
} # }}}


sub BuildMenus { # {{{
        my $res      = '';
        my $last_sec = '';
	my $need_close = undef;

	open ALL_INDEX, ">$out_dir_tmp/all.html" or &CleanAndDie("Can't create all.html file: $!");
	print ALL_INDEX &TemplateFile($template_all_start,
					{ 'TITLE'       => &HTMLEncode($title),
					  'SECTIONLIST' => &SectionsToHTML('', 'all') });

	if (defined $dwww_regdocs_cache) {
		open CACHE, ">$dwww_regdocs_cache.tmp.$$" or $dwww_regdocs_cache = undef;
	}

        foreach my $sec (sort keys %doc_list) {
		my $fname = &SectionToFileName($sec, $single_index);
		open SINGLE_INDEX, ">$out_dir_tmp/" . $fname
				or &CleanAndDie("Can't create $fname: $!");

		print SINGLE_INDEX  &TemplateFile($template_single_start,
						  { 'TITLE'       => &HTMLEncode($title),
						    'SECTION' 	  => &HTMLEncode($section_names{$sec}),
						    'SECTIONLIST' => &SectionsToHTML($sec, $single_index)});
		print SINGLE_INDEX "<dl>\n";

		my $alllink = &SectionToFileName($sec, $all_index);	
		print ALL_INDEX "<h2 class=\"c\"><a name=\"" . $alllink . "\" href=\"#m" . $alllink . 
				"\"><strong> Section: ". &HTMLEncode($section_names{$sec}) . "</strong></a></h2>\n<dl>";

		print SINGLE_INDEX "\n<!-- Section: " . &HTMLEncode($section_names{$sec}) . " -->\n";
		foreach my $doc (sort sort_documents @{$doc_list{$sec}}) {
			$res = &DocumentToHTML($doc);
			print SINGLE_INDEX "<!-- begin entry -->\n";
			print SINGLE_INDEX $res;
			print SINGLE_INDEX "<!-- end entry -->\n";
			print ALL_INDEX $res;

			if (defined $dwww_regdocs_cache and exists $doc->{'document'}) {
				print CACHE join( "\01", ( $doc->{'document'},
							   $section_names{$sec},
							   $fname . '#' . &HTMLEncode($doc->{'document'}),
							   &GetURL($doc->{'frm_name_0'}, $doc->{'frm_file_0'}),
							   $doc->{'title'}
							) ) . "\n";
			}

		}

		print SINGLE_INDEX "</dl>\n";
		print ALL_INDEX "</dl>\n";
		print SINGLE_INDEX  &TemplateFile($template_single_end, {});
		close SINGLE_INDEX;


	}

	print ALL_INDEX &TemplateFile($template_all_end, {});
	close ALL_INDEX;

	if (defined $dwww_regdocs_cache) {
		close CACHE;
		rename("$dwww_regdocs_cache.tmp.$$", "$dwww_regdocs_cache");
		chmod (0644, "$dwww_regdocs_cache");
		return 0;
	}

} # }}}

sub CreateIndex() { # {{{
	if (%sections) {
		link("$out_dir_tmp/" . &SectionToFileName((sort keys %sections)[0], $single_index),
     		"$out_dir_tmp/index.html")
			or print STDERR "Can't create index.html link: $!\n";
	} else {
		open INDEX, ">$out_dir_tmp/all.html" or &CleanAndDie("Can't create all.html file: $!");
		print INDEX &TemplateFile($template_nosections,
					{ 'TITLE'       => &HTMLEncode($title) } );
		close INDEX;
		link("$out_dir_tmp/all.html", "$out_dir_tmp/index.html")
			or print STDERR "Can't create index.html link: $!\n";
	}
} # }}}
