#!/usr/bin/perl
##/usr/local/bin/perl5
##/nfs/tools/local/bin/perl

##############################################################################
# search.cgi - Perl5 script to search MHonArc index for deep-sky observations.
# Requirements: Needs access to MHonArc 'maillist.html' index.
#
# Called from: http://www.visualdeepsky.org/search.html
# Author:  Lew Gramer <dedalus@alum.mit.edu>
# Created: 26 January 1998
##############################################################################


$| = 1;
$version = "1.0";
$maillist = "netastrocatalog/maillist.html";
$searchform = "search.html";
$loop = 0;


&ParseForm;
&DoSearch;

sub ParseForm {
    if ($ENV{'REQUEST_METHOD'} eq 'GET')
    {
	@pairs = split(/&/, $ENV{'QUERY_STRING'});
    }
    elsif ($ENV{'REQUEST_METHOD'} eq 'POST')
    {
	read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
	@pairs = split(/&/, $buffer);
    }
    else
    {
	&error('Bad or Unknown Request Method');
    }

    foreach $pair (@pairs)
    {
	local($name, $value) = split(/=/, $pair);
	$name =~ tr/+/ /;
	$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
	$value =~ tr/+/ /;
	$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
	$value =~ s/<!--(.|\n)*-->//g;
	if (($name =~ /^required-/) && (!$value))
	{
	    push(@missing_fields,$name);
	}
	if (($name =~ /email/) &&
	    (($value =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)/) ||
	     ($value !~ /^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,3}|[0-9]{1,3})(\]?)$/)))
	{
	    &error("$value is not a legal email address for $name. Please go back and try again.");
	}

	$INPUT{$name} = $value;
    }

    if (@missing_fields)
    {
	&error('missing_fields');
    }
}


sub DoSearch {
    #### Check the user input for potential security attacks!
    $id = $INPUT{'ids'};
    $allids = $INPUT{'allids'};
    $Catalog = $INPUT{'catalogs'};
    $catalog = lc($Catalog);
    $aperture = $INPUT{'aperture'};
    $aperture = uc($aperture);
    $generic = "[+-]? *[0-9][0-9.=/+-]*";
    if ( $id =~ /[;&><`]/ || $id =~ /(\|\||[^a-z][a-z]?sh -|eval|exec)/ )
    {
	&error('insecure_data');
    }


    #### Build the regular expression for the file search
    #### NOTE: ORDERING in the list below IS significant!
    #### NOTE 2: Several of the obscure catalogs have very
    ####	 weak id naming conventions. Thus we guard
    ####	 against excessive false negatives below by
    ####	 editing the searcher's '$id' to contain a
    ####	 whole slough of open wildcards! This will
    ####	 mean more false POSITIVES, but that's OK.
####    $re = "'(iaac).*[^a-z0-9]";
    $re = "'.*[^a-z0-9]";
    if ($catalog =~ /^messier/)		{ $re .= "(m|messier)[-]? *"; 
					  $generic = "[0-9][0-9]?[0-9]?"; }
    elsif ($catalog =~ /^ngc/)		{ $re .= "(n|n[ .]?g[ .]?c[.]?)[-]? *";
					  $generic = "[0-9][0-9]?[0-9]?[0-9]?"; }
    elsif ($catalog =~ /^ic/)		{ $re .= "(i|i[ .]?c[.]?)[-]? *";
					  $generic = "[0-9][0-9]?[0-9]?[0-9]?"; }
    elsif ($catalog =~ /^herschel/)	{ $re .= "(h|hi[-]?|hii[-]?|hiii[-]?|hiv[-]?|hv[-]?|hvi[-]?|hvii[-]?|hviii[-]?|herschel[-iv]*) *";
					$generic = "[0-9][0-9]?[0-9]?[0-9]?[a-e]?[-]?[0-9]?[a-e]?"; }
    elsif ($catalog =~ /^eso/)		{ $re .= "(e[ .]?s[ .]?o[.]?)[-]? *"; 
					  $id =~ s/[ +0\.\-][ +0\.\-]*/\.*/g;
					  $id = '.*' . $id;
					  $generic = ""; }
    elsif ($catalog =~ /^common/)	{ $generic = ""; }
    elsif ($catalog =~ /^upsalla/ || $catalog =~ /^ugc/)
					{ $re .= "(u|ugc|upsall[a-z -]*)[-]? *"; }
    elsif ($catalog =~ /^mcg/)		{ $re .= "(mcg)[-]? *";
					  $id =~ s/[ +0\.\-][ +0\.\-]*/\.*/g;
					  $id = '.*' . $id;
					}
    elsif ($catalog =~ /^pgc/)		{ $re .= "(pgc)[-]? *"; }
    elsif ($catalog =~ /^arp/)		{ $re .= "(arp[a-z -]*|apg)[-]? *"; }
    elsif ($catalog =~ /^zwicky/)	{ $re .= "(z|zw[g]?|zwicky[a-z -]*)[-]? *";
					  $id =~ s/[ +0\.\-][ +0\.\-]*/\.*/g;
					  $id = '.*' . $id;
    					}
    #### NOTE: Naming conflict between Abell pn catalog and Abell cg catalog!
    elsif ($catalog =~ /^abell/)	{ $re .= "(a|abel[a-z -]*)[-]? *";
					  $generic = "[0-9][0-9]?[0-9]?[0-9]?"; }
    elsif ($catalog =~ /^hickson/)	{ $re .= "(hgc|hcg[c]?|hick[a-z -]*) *[-]? *"; }
    elsif ($catalog =~ /^pn/)		{ $re .= "(png|pn g|pn-g)[-]? *";
					  $id =~ s/[ +0\.\-][ +0\.\-]*/\.*/g;
					  $id = '.*' . $id;
    					}
    elsif ($catalog =~ /^perek/ || $catalog =~ /^pk/ || $catalog =~ /^p-k/)
					{ $re .= "(pk|p-k)[-]? *";
					  $id =~ s/[ +0\.\-][ +0\.\-]*/\.*/g;
					  $id = '.*' . $id;
					}
    elsif ($catalog =~ /^voronstov/ || $catalog =~ /^vv/ || $catalog =~ /^v-v/)
					{ $re .= "(vv|v-v|voron[a-z -]*)[-]? *"; }
    elsif ($catalog =~ /^collinder/ || $catalog =~ /^cr/)
					{ $re .= "(cr|col|coll|collinder[a-z -]*)[-]? *"; }
    elsif ($catalog =~ /^mel/)		{ $re .= "(mel[a-z -]*)[-]? *"; }
    #### NOTE: Naming conflict between Stock oc catalog and Struve ms catalog!
    elsif ($catalog =~ /^stock/)	{ $re .= "(st|st[ok][a-z -]*)[-]? *"; }
    elsif ($catalog =~ /^aitken/)	{ $re .= "(a[ .]?d[ .]?s[.]?|ai[a-z -]*)[-]? *";
					  $generic = "[+-]? *[0-9][0-9.=/+-]*[a-k-]*"; }
    elsif ($catalog =~ /^burnham/)	{ $re .= "(b[ .]?d[ .]?s[.]?|bu[a-z -]*)[-]? *";
					  $generic = "[+-]? *[0-9][0-9.=/+-]*[a-k-]*"; }
    elsif ($catalog =~ /^struve/)	{ $re .= "(s[ .]?t[ .]?f[.]?|o?str[a-z -]*)[-]? *";
					  $generic = "[+-]? *[0-9][0-9.=/+-]*[a-k-]*"; }
    elsif ($catalog =~ /^washington/)	{ $re .= "(w[ .]?d[ .]?s[.]?|wa[a-z -]*)[-]? *";
					  $generic = "[+-]? *[0-9][0-9.=/+-]*[a-k-]*"; }
    elsif ($catalog =~ /^tombaugh/)	{ $re .= "(tom[a-z -]*)[-]? *"; }
    elsif ($catalog =~ /^basel/)	{ $re .= "(ba|bas[a-z -]*)[-]? *"; }
    elsif ($catalog =~ /^berk/)		{ $re .= "(be|berk[a-z -]*)[-]? *"; }
    elsif ($catalog =~ /^do/)		{ $re .= "(do|d[do][dlm][a-z -]*)[-]? *"; }
    elsif ($catalog =~ /^tr/)		{ $re .= "(tr|tr[ou]m[a-z -]*)[-]? *"; }
    elsif ($catalog =~ /^palomar/)	{ $re .= "(pal|palomar[a-z -]*)[-]? *";
					  $generic = "[0-9][0-9]?"; }
    elsif ($catalog =~ /^j/)		{ $re .= "(j|jon[a-z -]*)[-]? *"; }
    elsif ($catalog =~ /^minkowski/)	{ $re .= "(m|mink[a-z]*)[ -]? *";
					  $generic = "[1-4] *[ -]+ *[0-9][0-9]?[0-9]?"; }
    elsif ($catalog =~ /^van/ || $catalog =~ /^vdb/)
					{ $re .= "(vdb[ha]*|van|berg[a-z -]*)[-]? *"; }
    elsif ($catalog =~ /^shakh/)	{ $re .= "(shk[h]?[b]?|shak[h]?[b]?|shak[h]?bazian[a-z -]*) *[-]? *";
					  $generic = "[0-9][0-9]?[0-9]?"; }
    elsif ($catalog =~ /^sharp/)	{ $re .= "(sh|sharp[a-z -]*)[-]? *"; }
    elsif ($catalog =~ /^ced/)		{ $re .= "(ced[a-z -]*)[-]? *"; }
    elsif ($catalog =~ /^lyn/)		{ $re .= "(l[bd]n|lynd[a-z -]*)[-]? *"; }
    elsif ($catalog =~ /^barnard/)	{ $re .= "(b|barn[a-z -]*)[-]? *"; }
    elsif ($catalog =~ /^markarian/ || $catalog =~ /^mrk/)
					{ $re .= "(mk|mrk|marka[a-z -]*)[-]? *"; }
    elsif ($catalog =~ /^cgcg/)		{ $re .= "(c[ .]?g[ .]?c[.]?[g]?[ .]?)[-]? *";
					  $id =~ s/[ +0\.\-][ +0\.\-]*/\.*/g;
					  $id = '.*' . $id;
					  $generic = "[0-9][0-9-]*"; }
    elsif ($catalog =~ /^other/)	{ $generic = ""; }
    elsif ($catalog =~ /^id-constel/) {
	if ($allids =~ /on/o) {
	    $generic = "[^a-z0-9]([a-z][a-z]?|v[0-9]+|[1-9][0-9]?[0-9]?|alpha|alfa|beta|bet|gamma|gam|delta|del|eps|epsilon|zeta|zet|eta|theta|iota|kappa|kap|lambda|lam[a-z]*|mu|nu|xi|ksi|omicron|omi|pi|rho|sigma|sig|tau|upsilon|phi|chi|kai|psi|omega)[ \t	0-9-]+[ \t	0-9a-f-]*(and|ant|aps|apus|apod|aqr|aql|aqu|ara|ari|aur|boo|cae|cam|cnc|canc|cvn|cma|cmi|can|cap|car|cas|cen|cep|cet|cha|cir|col|com|cra|crb|crv|cor|crt|cra|cru|cyg|del|dor|dra|equ|eri|for|gem|gru|her|hor|hya|hyi|hyd|ind|lac|leo|lmi|lep|lib|lup|lyn|lyr|men|mic|mon|mus|nor|oct|oph|ori|pav|peg|per|phe|pho|pic|psc|psa|pis|pup|pyx|ret|sge|sgr|sag|sco|scl|sct|scu|ser|sex|tau|tel|tri|tra|tuc|uma|umi|urs|vel|vir|vol|vul)[a-z]*";
	} else {
	    local($constid, $constel) = split(' ', $INPUT{'ids'});
	    $constel = substr($constel, 0, 3);
	    $id = "(" . $constid . "[- ]*" . $constel . "[a-z]*)";
	}
    }
    # User MUST specify a valid catalog name
    else {
	&error('insecure_data');
    }

    if ($allids =~ /on/o)	{ $re .= $generic; }
    else			{ $re .= $id; }

    $re .= "[^a-z0-9.+-]";

    # Limit search by aperture, if desired...
####    if ($aperture !~ /^ALLAP/) {
    if (length($aperture) > 0 && $aperture !~ /^ALLAP/) {
        $re .= ".*inst.*";

        if ($aperture =~ /^BINO/)
        { $re .= "(bino|monoc|unaided|naked|find|spot).*"; }

        elsif ($aperture =~ /^SMALL/)
        { $re .= "[^0-9.]([2-6][ -]*([\"]|inch)|[2-6][.][0-9]+[ -]*([\"]|inch)|[5-9][0-9][- ]*mm|1[0-5][0-9][- ]*mm|[5-9] *cm|[5-9][.][0-9]+ *cm|1[0-5][.][0-9]+ *cm|1[0-5] *cm|etx.*|tv[- ]*[0-9]+|c5)"; }

        # Option not currently supported by HTML form...
        elsif ($aperture =~ /^MEDIUM/)
        { $re .= "[^0-9.]([7-9]([\"]|inch)|[7-9][^0-9].*([\"]|inch)|1[0-2]([\"]|inch)|1[0-2][^0-9].*([\"]|inch)|1[6-9] *cm|1[6-9][0-9] *mm|2[0-9] *cm|2[0-9][0-9] *mm|3[0-2] *cm|3[0-2][0-9] *mm|c8|c11)"; }

        elsif ($aperture =~ /^SMMID/)
        { $re .= "[^0-9.]([7-9]([\"]|inch)|[7-9][^0-9].*([\"]|inch)|1[6-9] *cm|1[6-9][.][0-9]+ *cm|1[6-9][0-9] *mm|2[0-4] *cm|2[0-4][.][0-9]+ *cm|2[0-4][0-9] *mm|c8|c9[.]25)"; }

        elsif ($aperture =~ /^MIDLA/)
        { $re .= "[^0-9.](1[0-2]([\"]|inch)|1[0-2][^0-9].*([\"]|inch)|2[5-9] *cm|2[5-9][.][0-9]+ *cm|2[5-9][0-9] *mm|3[0-2] *cm|3[0-2][.][0-9]+ *cm|3[0-2][0-9] *mm|c11)"; }

        elsif ($aperture =~ /^LARGE/)
        { $re .= "[^0-9.](1[3-9][ -]*([\"]|inch)|1[3-9][.][0-9]+[ -]*([\"]|inch)|20([\"]|inch)|20[^0-9][ -]*([\"]|inch)|3[3-9] *cm|3[3-9][.][0-9]+ *cm|4[0-9] *cm|4[0-9][.][0-9]+ *cm|5[0-1] *cm|5[0-1][.][0-9] *cm|c14)"; }

        elsif ($aperture =~ /^MONDO/)
        { $re .= "[^0-9.](2[1-9]([\"]|inch)|2[1-9][^0-9][^a-z]*([\"]|inch)|[3-9][0-9]([\"]|inch)|[3-9][0-9][^0-9][^a-z]*([\"]|inch)|[1-9][0-9][0-9]([\"]|inch)|[1-9][0-9][0-9][^0-9][^a-z]*([\"]|inch)|5[2-9] *cm|[6-9][0-9] *cm|[1-9][0-9][0-9] *cm|.*[^a-z]meter)"; }

        # User MUST click a valid aperture radiobutton
        else {
            &error('insecure_data');
        }
        $re .= "[^a-z0-9.+-]";
    }

    # Finish off our regexp query string properly
    $re .= "'";


    #### Output standard HTML Header
print <<EOM;
Content-Type: text/html

    <BASE HREF="http://www.visualdeepsky.org/">
    <HTML>
    <HEAD><TITLE>IAAC Observations Matching Your Criteria</TITLE></HEAD>
    <BODY BACKGROUND="../skybg.gif" TEXT=#FFFCA0 LINK=#00BFFF VLINK=#FF00FF>
    <H1>IAAC Observations Matching Your Criteria</H1>
    <HR>
    <P>
EOM


    #### Perform the file search and print out results!
    @found = qx{ grep -E -i $re $maillist };
    $hitcount = $#found + 1;
print <<EOM;
    <P>
    Found $hitcount matches for regular expression $re
    <P>
<!-- Now done by s/// in search.cgi! Fixes a bug in konqueror & the Mac browser:
    <BASE HREF="http://www.visualdeepsky.org/netastrocatalog/">
-->
    <UL>
EOM
    for $line (@found) {
	# "Fix" the URL to point to our archive subdirectory...
	$line =~ s|"(msg[0-9]+.html)"|"netastrocatalog/\1"|;
	print $line;
    }


    #### Append the search form to allow convenient redo of search
print <<EOM;
    </UL>
    <BASE HREF="http://www.visualdeepsky.org/">
    <HR>
    <H2>Refine or Change Your Search</H2>
EOM
    local($insideHdr) = 1;
    local($catalogbase) = split('[(*]', $Catalog);
    open(FORM, $searchform) || &error("Could not open $searchform: $!");
    for $formline (<FORM>) {
	# Ignore any HTML that comes before the FORM itself
	if ($formline =~ /FORM.*search.cgi/o) {
	    $insideHdr = 0;
	}
	elsif ($insideHdr) {
	    next;
	}
	elsif ($formline =~ /$catalogbase/o)
	{
	    $formline =~ s/OPTION/OPTION Selected/o;
	}
	elsif ($formline =~ /INPUT name="ids"/o)
	{
	    $formline =~ s/name="ids"/name="ids" value="$id"/;
	}
	print $formline;
    }
    close(FORM);


    #### Output standard HTML Trailer
print <<EOM;
    </BODY>
    </HTML>
EOM
}


sub error {
    ++$loop;
    $error = $_[0];
    if ($error eq 'missing_fields')
    {
	$error = "The following field(s) are required to perform search:<ul>\n";
	foreach $missing_field (@missing_fields) {$error .= "<li>$missing_field\n";}
	$error .= "</ul>Please go back and fill out those fields.\n";
    }

    if ($error eq 'insecure_data')
    {
	print "Location: insecure.html\n\n";
    }
    elsif ($INPUT{'error_url'})
    {
	print "Location: $INPUT{'error_url'}\n\n";
    }
    elsif (($INPUT{'error_path'}) && ($loop < 2))
    {
	open(TEMPLATE,"$path$INPUT{'error_path'}") || &error("Could not open $path$INPUT{'error_path'}: $!");
	flock(TEMPLATE,2);
	@LINES = <TEMPLATE>;
	close(TEMPLATE);
	print "Content-Type: text/html\n\n";
	foreach $LINE (@LINES)
	{
	    $LINE =~ s/\[error\]/$error/;
	    print $LINE;
	}
    }
    else
    {
print <<EOM;
Content-Type: text/html

    <HTML>
    <HEAD><TITLE>IAAC Search Error!</TITLE></HEAD>
    <BODY>
    <H1>IAAC Search Error!</H1>
    <STRONG>The following error(s) occured:<BR>
	$error</STRONG>
    <CENTER>
    <P><BR><BR><BR>
    * <A href="http://www.visualdeepsky.org">Internet Amateur Astronomers Catalog</A> *<BR>
    * Copyright 2003, <A href="mailto:owner-netastrocatalog\@visualdeepsky.org">Lew Gramer</A> *<BR>
    * All Rights Reserved *
    </CENTER>
    </BODY>
    </HTML>
EOM
    }
    exit(0);
}