dwww 1.12.1+deb8u1 / usr / sbin / dwww-build-menu

#!/usr/bin/perl
# vim:ft=perl:cindent:ts=4:sts=4:sw=4:et: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 547 2011-01-15 15:29:55Z robert $
#

use strict;
use warnings;
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 $doc_base_fmt = 'doc-base'; # special format indicating that dwww
                               # should generate index of files containing
                               # the registered files

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;
my $last_err_file = "";

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);
} # }}} 


## 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++;
            } elsif (glob($w)) {
                $files{$w} = '1';
                $doc_entry->{'frm_name_' . $known} = $doc_base_fmt;
                $doc_entry->{'frm_file_' . $known} = $f . '/' . $entry->{'document'};
                $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 $fmt = $doc->{"frm_name_$i"};
            my $loc = $doc->{"frm_file_$i"};
            $res .= "[<a href=\"" . &GetURL($fmt, $loc);
            ($fmt = $loc) =~ s/\/.*$// if $fmt eq $doc_base_fmt; 
            $res .= "\">" . $fmt . "</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";
    }
} # }}}