#!/usr/bin/perl
# vim:ft=perl:cindent:ts=8:et:fdm=marker:cms=\ #\ %s
#
# Find all docs related to one program or find matching entries in Debian Doc. Menu
# "$Id: dwww-find,v 1.46 2005-10-05 21:25:04 robert Exp $"
#

use strict;

use Debian::Dwww::Utils;
use Debian::Dwww::Initialize;


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

my $dwww_quickfind_db   = $dwwwvars->{'DWWW_QUICKFIND_DB'};
my $dwww_menu_dir       = $dwwwvars->{'DWWW_HTMLDIR'} . "/menu";
my $dwww_swish_index    = "/var/cache/dwww/dwww.swish++.index";
my $dwww_swish_conf     = "/usr/share/dwww/swish++.conf";
my $dwww_regdocs_cache  = $dwwwvars->{'DWWW_REGDOCS_DB'};
$dwww_regdocs_cache     = undef if "$dwww_regdocs_cache" eq "" and not  ( -r "$dwww_regdocs_cache" );

undef %{$dwwwvars};

my $templates_dir  = "/usr/share/dwww";
my $template_start = "$templates_dir/dwww-find.start";
my $template_end   = "$templates_dir/dwww-find.end";

my %hrefs = (  
            'man'       => '/cgi-bin/dwww?type=man&amp;location=', 
            'runman'    => '/cgi-bin/dwww?type=runman&amp;location=',
            'dir'       => '/cgi-bin/dwww?type=dir&amp;location=',
            'info'      => '/cgi-bin/info2www?file=',
            'file'      => '/cgi-bin/dwww?type=file&amp;location=',
            'menu'      => '/dwww/menu/',
            'search'    => '/cgi-bin/dwww?search=',
            'dpkg'      => '/cgi-bin/dpkg?query='
        );

my $dpkgwwwcgi = "/usr/lib/cgi-bin/dpkg";


my $dpkg="dpkg";
if ( -x "/usr/bin/dlocate" && -s "/var/lib/dlocate/dlocatedb" 
    && -s "/var/lib/dlocate/dpkg-list" ) {
        $dpkg="dlocate";
} else {
        $dpkg="dpkg";
}

#########################################################################
#
# Main program
#

if (! defined $ARGV[0]) {
    print STDERR "usage: $0 [--package|--menu|--documentation] searcharg\n";
    exit(1);
}

my $mode="p";
my $skip=0;
while ($ARGV[0] =~ m/^--(.*)$/) {
        if ($1 eq "package") { $mode = "p"; }
        elsif ($1 eq "menu") { $mode = "m"; }
        elsif ($1 eq "documentation") { $mode = "d"; }
        elsif ($1 =~ m/^skip=(\d+)$/) { $skip=$1 ; }
        else {
                print STDERR "usage: $0 [--package|--menu|--documentation] searcharg\n";
                exit(1);
        }
        shift @ARGV;
}





my $f_cnt = 0;

print &TemplateFile($template_start, { 'TITLE' => 'Search results',
                                     'VALUE'   => &HTMLEncode(join(" ", @ARGV)),        
                                     'MCHECKED' => $mode eq "m" ? 'checked' : '',
                                     'PCHECKED' => $mode eq "p" ? 'checked' : '',
                                     'DCHECKED' => $mode eq "d" ? 'checked' : ''
                                 });

if ($mode eq "p") {
        $f_cnt = &SearchPackage(@ARGV);
} elsif ($mode eq "m") {
        $f_cnt = &SearchMenus($dwww_menu_dir, $ARGV[0]);
} elsif ($mode eq "d") {
        $f_cnt = &SearchRegisteredDocumentation($ARGV[0], $skip, 50);
}

print "<strong>Not found!</strong>\n" unless $f_cnt;


print &TemplateFile($template_end, { } );



#########################################################################
#
# Local functions
#

#########   Package search functions   ###################################
#
sub FindPkg { # {{{
        my $searchfor = shift;
        my @ret = ();

        if ( -r "$dwww_quickfind_db" ) {
                open (FINDPKG, "dwww-quickfind \"$searchfor\" \"$dwww_quickfind_db\"|");
                while (<FINDPKG>) {
                    chomp();
                    push(@ret, $_);
                }
        } else {
                my %pkgs = ();
                my @searchargs = ("$dpkg", "-S", "\"$searchfor\"");
                open (FINDPKG, "@searchargs |")
                        or die "can't open $dpkg -S: $!\n";
                while (<FINDPKG>) {
                    chomp();
                    my ($pkg, $file) = split(/:\s*/, $_, 2);
                    next if $pkg =~ /\s/;             # skip divertions
                    if ($pkg eq $searchfor) {
                            $pkgs{$pkg} = 1;
                    }
                    elsif ( $file =~ m/^.*\/(usr\/games|s?bin)\/$searchfor$/o ) {
                            $pkgs{$pkg} = 1;
                    };
                }
                @ret = sort( keys %pkgs );
        }
        close FINDPKG;
        return @ret;
} # }}}

sub SearchPackage { # {{{
        my @args  = @_;
        my $f_cnt = 0;
        
        foreach my $arg (@args) {
                print "<h2>Documentation related to <em>" . &HTMLEncode("$arg") . "</em></h2>\n";
                foreach my $pkg (&FindPkg("$arg")) {
                        print "<h3><strong>Package:</strong> ";
                        if ( -x "$dpkgwwwcgi" ) {
                                print "<a href=\"" . $hrefs{'dpkg'} . &URLEncode("$pkg"). "\">"
                                        . &HTMLEncode("$pkg") . "</a>";
                        } else {
                                print &HTMLEncode("$pkg");
                        }
                        print "</h3>\n";
                        
                        $f_cnt += &PkgDescription("$pkg");
                        my @filelist = sort &GetPkgFileList("$pkg");
                        $f_cnt += &RegisteredDocBaseInPkg(@filelist);
                        $f_cnt += &MansInPkg(@filelist);
                        $f_cnt += &InfosInPkg (@filelist);
                        $f_cnt += &DocsInPkg (@filelist);
                }
                $f_cnt += &Apropos ("$arg");
        }
        return $f_cnt;
} # }}}

sub GetPkgFileList { # {{{
        my $pkg = shift;
        my @ret = ();
        
        open (FILELIST, "$dpkg -L \"$pkg\"|");
        while (<FILELIST>) {
                chomp();    
                push(@ret, $_);
        }
        close FILELIST;
        return @ret;
} # }}}

sub MansInPkg { # {{{
        my @files       = @_;
        my $res         = 0;
        my $table       = undef;

        foreach $_ (@files) {
                next unless m/\/man\/man[1-9n]\//;
                next unless ( -f "$_");
                if (!$res) {
                        $res = 1;
                        $table = &BeginTable(\*STDOUT, "Manual pages:", 3);
                }
                my $uri = &URLEncode($_);
                s/^.*\///;
                s/\.(gz|bz2)$//;
                s/\.([^.]*)$/($1)/;
                &AddToTable(\*STDOUT, $table, 
                        "<a href=\"" . $hrefs{'man'} . "$uri\">$_</a>");
        }
        if ($res) {
                &EndTable(\*STDOUT, $table);
        }
        return $res;
} # }}}

sub InfosInPkg() { # {{{
        my @files       = @_;
        my $res         = 0;
        my $table       = undef;

        foreach $_ (@files) {
                next unless m/\/info\/.*\.info(\.gz)?$/;
                next unless ( -f "$_");
                if (!$res) {
                        $res = 1;
                        $table = &BeginTable(\*STDOUT, "Info files:", 3);
                }
                my $uri = &URLEncode($_);
                s/^.*\///;
                s/^\..*//;
                &AddToTable(\*STDOUT, $table, 
                        "<a href=\"" . $hrefs{'info'} . "$uri\">$_</a>");
        }
        if ($res) {
                &EndTable(\*STDOUT, $table);
        }
        return $res;
} # }}}

sub RegisteredDocBaseInPkg { # {{{
        my @files       = @_;
        my $res         = 0;
        my $table       = undef;
        my @docb_files  = ();

        return 0 unless defined $dwww_regdocs_cache;

        foreach $_ (@files) {
                next unless m/\/usr\/share\/doc-base\/([^\/]+)/;
                next unless ( -f "$_");
                push (@docb_files, $1);
        }

        return 0 unless $#docb_files > -1;
        return 0 unless open (CACHE, "<$dwww_regdocs_cache");
        
        while (<CACHE>) {
                my ($name,$section,$menulink,$link,$doctitle)  = split(/\001/, $_, 5);
                foreach my $i (0 .. $#docb_files) {
                        if ($docb_files[$i] eq $name) {
                                if (!$res) {
                                        $res = 1;
                                        $table = &BeginTable(\*STDOUT, "Registered documentation:", 1);
                                }        
                                &AddToTable(\*STDOUT, $table, 
                                        "<a href=\"" . $link ."\">" . &HTMLEncode($doctitle) . "</a>" .
                                        " &nbsp; <small><i>(menu section: <a href=\"" . $hrefs{'menu'} . $menulink . "\">" .
                                        &HTMLEncode($section) . "</a>)</i><small>" );
                                delete $docb_files[$i];
                                last;
                        }
                }
                last if $#docb_files < 0;
        }
        close CACHE;
                
        if ($res) {
                &EndTable(\*STDOUT, $table);
        }
        return $res;
} # }}}

sub DocsInPkg { # {{{
        my @files       = @_;
        my $res         = 0;
        my $table       = undef;

        foreach $_ (@files) {
                next unless m/^\/usr(\/share)?\/doc\//;
                next unless ( -d "$_");
                if (!$res) {
                        $res = 1;
                        $table = &BeginTable(\*STDOUT, "Other documents:", 2);
                }
                my $uri = &URLEncode($_);
                &AddToTable(\*STDOUT, $table, 
                        "<a href=\"" . $hrefs{'dir'} . "$uri\">$_</a>");
        }
        if ($res) {
                &EndTable(\*STDOUT, $table);
        }
        return $res;
} # }}}

sub Apropos { # {{{
        my $searchfor   = shift;
        my @apropos     = ();
        my $res         = 0;
        my $table       = undef;
        my @searchargs  = ("man", "-k", "\"$searchfor\"");
        
        open (APROPOS, "@searchargs |")
                or die "can't open man -k: $!\n";
        while (<APROPOS>) {
                chomp();
                push (@apropos, $_);
        }
        close APROPOS;

        foreach $_ (sort @apropos) {
                chomp();
## Example "man -k" output that we are trying to parse:
## a2p (1)              - Awk to Perl translator
## #include <qslider.h> (3qt) [qslider] - Vertical or horizontal slider
##
                next unless (/^(.*?)\s\(([1-9]\S*)\)(\s*\[.*\])?\s+- .*$/);
                my $man  = "$1";
                my $sect = "$2";
                my $tmp  = defined $3 ? "$3" : "";
                if ($tmp =~  /\s*\[(.*)\]\s*/) {
                        $_ = "$1/$sect";
                } else {
                        $_ = "$man/$sect";
                }
                if (!$res) {
                        $res = 1;
                        $table = &BeginTable(\*STDOUT, "Manual page search:", 3);
                }

                my $uri = &URLEncode($_);
                $_ = &HTMLEncode("$man($sect)");
                &AddToTable(\*STDOUT, $table, 
                        "<a href=\"" . $hrefs{'runman'} . "$uri\">$_</a>");
        }
        
        if ($res) {
                &EndTable(\*STDOUT, $table);
        }
        return $res;
} # }}}

sub PkgDescription () { # {{{
        my $pkg         = shift;
        my $descr       = '';
        my $synopsis    = undef;
        my $fdescr      = 0;     
        my $res         = 0;
        my $table       = undef;
        
        return 0 unless ( -x "/usr/bin/apt-cache" );

        open PKGDESC, ("apt-cache show -o 'APT::Cache::AllVersions=0' \"$pkg\" 2>/dev/null |");
        while (<PKGDESC>) {
                if (!$fdescr && s/^Description:\s+//) {
                        chomp();
                        $synopsis = $_;
                        $fdescr = 1;
                } elsif ($fdescr) {
                    last unless /^ /;                            
                    $descr .= $_;
                }
        }
        close PKGDESC;

        return 0 unless defined $synopsis;
        print '<strong>Description:</strong> ' . &HTMLEncode("$synopsis");
        print "\n<br>";
        print &HTMLEncodeAbstract($descr);
        return 1;
} # }}}


#########   Menu search functions   #######################################
#
sub SearchMenus { # {{{
        my $dir        = shift;
        my $searchfor  = shift;
        my $match_cnt  = 0;
        my @patterns   = ();

        print "<h2>Menu entries related to <em>" . &HTMLEncode("$searchfor") . "</em></h2>\n";

        if (not opendir DOCBASEDIR, $dir) {
                print "Can't open directory $dir: $!\n";
                return $match_cnt;
        }   
        
        # quote special regexp characters
        $searchfor      =~ s/[\.\^\$\|\(\)\[\]\{\}\*\+\?\\]/\\$&/g;
        my @patterns    = split(/\s+/, $searchfor);
    
        while (my $f = readdir(DOCBASEDIR)) {
                next if -d $f;
                next unless $f =~ /^s.*\.html$/;

                $match_cnt += &SearchinMenuFile($dir, $f, @patterns);
        }
        return $match_cnt;
} # }}}

sub SearchinMenuFile() { # {{{
        my $dir       = shift;
        my $file      = shift;
        my @patterns  = @_;
        my $sec       = undef;
        my $res       = undef;
        my $entry     = undef;
        my $srch      = undef;
        my $inentry   = 0;
        my $found     = 0; 
        my $match_cnt = 0;
#my @patterns  = split(/\s+/, $searchfor);

        open FILE, "<$dir/$file" or die "Can't open file";
    
        while (<FILE>) {
                if (!defined $sec) {
                        $sec = $1 if m/^<!-- Section: (.*) -->$/;
                } elsif (m/^<!-- begin entry -->/) {
                        $inentry = 1;
                        $srch    = '';
                        $entry   = '';
                        $found   = 0;
                } elsif (m/^<!-- end entry -->/) {
                        $inentry = 0;
                        $found   = 1;
                        $_       = $srch;
                        foreach my $pat (@patterns) {
                                if (not $srch =~ m/$pat/i) {
                                        $found = 0;
                                        last;
                                }
                        }
                        $res .= $entry if ($found);
                        $match_cnt++ if ($found);
                        $srch    = '';
                } elsif ($inentry) {
                        $entry .= $_;
                        next if s/^<br><b>Formats:.*//;
                        s/<[^>]*>//g;
                        $srch .= $_;
                }
        }


        if (defined $res) {
                print "<h2>Section: <a href=\"" . $hrefs{'menu'} . 
                                        &URLEncode($file) ."\">$sec</a></h2>\n";
                print "<dl>\n";
                print $res;
                print "</dl>\n";
        }
        return $match_cnt;
} # }}}


#########   Registered docs search functions   #############################
#
sub PrintRegDocsPages { # {{{
        my $searchfor  = shift;
        my $startwith  = shift;
        my $maxperpage = shift;
        my $resultcnt  = shift;
        my $max        = 10;
        my ($first, $last);

        return unless (defined $resultcnt and defined $startwith and defined $maxperpage
                        and $resultcnt > $maxperpage and $maxperpage > 0);
        
        my $pagescnt = int ($resultcnt / $maxperpage);
        my $pageno   = int ($startwith / $maxperpage);
        $first       = 0;
        $last        = $pagescnt + 1;
        
        
        print "<center>\n";
        
        if ($pagescnt > $max) {
                $first = (int ($pageno / $max)) * $max - 1;
                $last  = $first +  $max + 1;
                $last  = $pagescnt + 1 if $last > $pagescnt;
        }

#       print STDERR '$f, $l, $pn,$pc,$res = ' . "$first,$last,$pageno,$pagescnt,$resultcnt\n";

        for (my ($i, $skip) = ($first, $first * $maxperpage); 
                        $i <= $last; 
                        $i++, $skip += $maxperpage) {
                next if $i < 0 or $i > $pagescnt;
                if ($i == $pageno) {
                        print "[<strong>" . ($i + 1) . "</strong>]\n"
                }
                else {
                        print "[<a href=\"" .  $hrefs{'search'} . $searchfor . "&amp;skip=" .
                                $skip . "&amp;searchtype=d\">";
                        
                        if ($i == $first) {
                                print "&lt;&lt;";
                        } 
                        elsif ($i == $last) {
                                print "&gt;&gt;";
                        }
                        else {
                                print ($i + 1);
                        }
                        
                        print "</a>]\n";
                }
        }
        print "</center>\n";
} # }}}
        
sub SearchRegisteredDocumentation { # {{{
        my $searchfor  = shift;
        my $startwith  = shift;
        my $maxperpage = shift;
        my @searchargs = ("/usr/bin/search++");
        my $resultcnt  = undef;
        my $desc       = '';

        if (not -x $searchargs[0]) {
                print "<strong>Error:</strong> Can't find <em>search++</em> program.\n";
                print "<br>Please install <a href=\"http://packages.debian.org/swish%2b%2b\">"
                        . "swish++</a> package.\n";
                return 1 ;
        }
        
        if (not -r $dwww_swish_index) {
                print "<strong>Error:</strong> Can't find generated index file\n";
                print "<br>Please check if <a href=\"" . $hrefs{'runman'} . "dwww-index%2b%2b/8\">"
                        . "dwww-index++(8)</a> has been run.\n";
                return 1;
        }
        
        if (defined $startwith and defined $maxperpage) {
                $startwith = $maxperpage * int ($startwith/$maxperpage);
        }

        push(@searchargs, "--config-file=$dwww_swish_conf");
        push(@searchargs, "--index-file=$dwww_swish_index");
        push(@searchargs, "--skip-results=$startwith") if defined ($startwith);
        push(@searchargs, ("-m", "$maxperpage")) if defined ($maxperpage);
        push(@searchargs, "\"$searchfor\"");

        # Swish++ WWW module
        use lib '/usr/lib/swish++';
        my $use_www = eval "require WWW";

        
        open (SEARCH, "@searchargs |")
                or die "can't open search++: $!\n";

        print "<h2>Registered documents related to <em>" . &HTMLEncode($searchfor) . "</em></h2>\n";
        print "<dl>\n";

        while (<SEARCH>) {
                if (/^# ignored: /) {
                        print "Following words were ignored: " . &HTMLEncode($') . "<br>\n";
                        next;
                }
                if (/^# not found: /) {
                        print "Following words weren't found: " . &HTMLEncode ($') . "<br>\n";
                        next;
                }
                if (/^# results: /) {
                        $resultcnt = $';
                        # print "Result count: $'<br>\n";
                        &PrintRegDocsPages($searchfor, $startwith, $maxperpage, $resultcnt);
                        next;
                }
                next if (/^#/);

                my($rank, $file, $size, $title ) = split( /__--__/, $_, 4);
                print "<dt><a href=\"" . $hrefs{'file'} . &URLEncode($file) 
                       . "\">" . &HTMLEncode("$title") . "</a> <em>($rank%)</em></dt>\n";
                
                if ($use_www and -r "$file") {
                        $desc = &WWW::extract_description("$file");
                        &WWW::hyperlink($desc);
                }
                $desc = &HTMLEncode($title) if $desc eq '';
                
                print "<dd>" . $desc . "</dd>\n";
                print "<dt><br></dt>\n";

        }
        print "</dl>\n";

        &PrintRegDocsPages($searchfor, $startwith, $maxperpage, $resultcnt);

        close SEARCH;

        return $resultcnt;
        
} # }}}

