#!/usr/bin/perl -w
#
# find_file.cgi
#
# Look through a provided database to find which CD/DVD image(s)
# contain a specified Debian package or source file.
# 
# Copyright (c) 2011 Steve McIntyre <93sam@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

use strict;
use DB_File;
use CGI;

my $dbdir = "/home/steve/debian/debian-cd/search/search-db";
my $cdimage_url = "http://cdimage.debian.org/cdimage/";
my @AREAS;
my %num_files;
my %fileinfo;
my %imageinfo;
my %labels;
my $query_term;
my @results;
my @chosen_areas;
my $l = "";
my $max_count = 1000;

my $version = "0.2";
my $title_base = "Debian CD search engine";

my $q = new CGI;
my $mode = "none";

sub print_footer () {
    print
        $q->hr,
        $q->address("$title_base version $version"),
        $q->address("Steve McIntyre <93sam\@debian.org>");
}

# Borrowed from Ikiwiki.pm
sub glob2re ($) {
    my $re=quotemeta(shift);
    $re=~s/\\\*/.*/g;
    $re=~s/\\\?/./g;
    return qr/^$re$/i;
}

sub read_text ($) {
    my $filename = shift;
    my $text = "no description";
    if (-f $filename) {
        open INFILE, "<", "$filename" || return $text;
        $text = "";
        while (<INFILE>) {
            chomp;
            $text .= $_;
        }
        close INFILE;
    }
    return $text;
}

sub log_error ($$) {
    my $errornum = shift;
    my $errortext = shift;

    print $q->header,
    $q->start_html($title_base),
    $q->h1($title_base),
    $q->p("Error: $errortext"),
    $q->p("<a href=\"" . $q->url . "\">Search again.</a>");
    print_footer();
    print $q->end_html;
    exit 0;
}

sub blank_form ($) {
    my $error = shift;
    print
        $q->header,
        $q->start_html($title_base),
        $q->h1("$title_base"), "\n";
    print $q->p("This tool searches for specified file names contained in Debian CD/DVD images."), "\n";
    print $q->p("Select which set(s) of images you wish to search:"), "\n";
    print $q->start_form(-method=>"GET");
    print $q->checkbox_group(-name=>'search_area',
                             -values=>\@AREAS,
                             -defaults=>['release'],
                             -linebreak=>'true',
                             -labels=>\%labels);
    print $q->textfield(-name=>'query',
                        -value=>'',
                        -size=>50,
                        -maxlength=>100);
    print $q->submit(-name=>'Search',
                     value=>'Search');
    if (length($error)) {
        print $q->p({-style=>'color: red'}, "ERROR: $error"), "\n";
    }
    print $q->p("Search terms should be in the form of shell globs (i.e. \"<i>cvs*deb</i>\" will match all files that start with <i>cvs</i> and end with <i>deb</i>.");
    print $q->end_form;
    print_footer();
    print $q->end_html;
    exit 0;
}

sub list_link ($) {
    my $link = $cdimage_url . shift;
    return $link;
}

sub iso_link ($) {
    my $link = $cdimage_url . shift;
    $link =~ s/list-/iso-/g;
    $link =~ s/list\.gz$/iso/g;
    return $link;
}

sub jigdo_link ($) {
    my $link = $cdimage_url . shift;
    $link =~ s/list-/jigdo-/g;
    $link =~ s/list\.gz$/jigdo/g;
    return $link;
}

sub pretty_name ($) {
    my $name = shift;
    $name =~ s/^.*\///g;
    $name =~ s/\.list\.gz$//g;
    return $name;
}    

chdir($dbdir) || log_error(500, "Failed to cd to $dbdir: $!\n");
opendir(my $dh, ".") || log_error(500, "Failed to open $dbdir: $!\n");
while (defined($_ = readdir($dh))) {
    m/(.*)\.db$/ and push(@AREAS, "$1");
}
closedir($dh);

foreach my $area(@AREAS) {
    $labels{$area} = "$area (" . read_text("$area.text") . ")";
}

@chosen_areas = $q->param('search_area');
$query_term = $q->param('query');

# Check what we've been given, if anything
if ( (!@chosen_areas) && 
     (!defined($query_term) || length($query_term) == 0)) {
    blank_form("");
}

if (!(@chosen_areas) && defined($query_term)) {
    blank_form("No search areas chosen");
}

if (@chosen_areas && 
    (!defined($query_term) || length($query_term) == 0)) {
    blank_form("No search terms entered");
}

my $count = 0;
my $re_search = glob2re($query_term);

# If we get here, we have stuff to work with. Yay!
foreach my $area (@chosen_areas) {
    my $db_file_name = "$dbdir/$area.db";
    $l .= "Looking in area $area, file $db_file_name<br>\n";
    dbmopen(%fileinfo, "$db_file_name", 0000) ||
        log_error(500, "Failed to open db file: $!\n");

    if ($query_term =~ /[\*\?]/) {
        # Will need to search through all the keys to allow for glob
        foreach my $file (keys %fileinfo) {
            if ($file =~ $re_search) {
                $count++;
                push(@results, "$file $fileinfo{$file}");
                if ($count >= $max_count) {
                    last;
                }
            }
        }
    } else {
        # We've been given an exact name - do the exact key lookup \o/
        push (@results, "$query_term $fileinfo{$query_term}");
    }
    if ($count >= $max_count) {
        last;
    }
    dbmclose %fileinfo;
}

print $q->header,
    $q->start_html("$title_base: $count results"),
    $q->h1($title_base), "\n";
if ($count >= $max_count) {
    print $q->p("More than $max_count results for \"$query_term\", showing the first $count only\n");
} else {   
    print $q->p("$count results for \"$query_term\"\n");
}
if ($count > 0) {
    print "<ol>\n";
    foreach my $result (sort (@results)) {
        my($found, @list) = split(' ', $result);
        print "<li> $found appears in:\n";
        print "<ul>";
        foreach my $image (sort(@list)) {
            print "<li>" . pretty_name($image);
            print " (<a href=\"" . list_link($image) . "\">list.gz</a> |";
            print " <a href=\"" . jigdo_link($image) . "\">jigdo</a> |";
            print " <a href=\"" . iso_link($image) . "\">iso</a>)";
        }
        print "</ul>";
    }
    print "</ol>";
}
print_footer();
print $q->end_html;