[% my $html= ''; my @errors; my @types= q( Wi perlquestion SoPW Seekers of Perl Wisdom D monkdiscuss PMD PM Discussions Ob obfuscated Obfu Obfuscation CU CUFP CUFP Cool Uses For Perl CC sourcecode Code Code Catacombs CQ categorized_question CatQ Categorized Questions CA categorized_answer CatA Categorized Answers Hlp sitefaqlet Help Monk Help Tu perltutorial Tut Tutorial U user User Po poem Poem Cr perlcraft Craft Sn snippet Snippet N perlnews News Q quest Quest Pol poll Poll M perlmeditation Med Meditations SP scratchpad SPad Scratch Pad MR modulereview ModRev Module Review BR bookreview BkRev Book Review pPd perlman perlman Perl Manpage pFn perlfunc perlfunc Perl Function pFq perlfaq_nodetype perlfaq Perl FAQ ) =~ /(\S.*\S)/g; my( %abbr, %desc, %typeId, %link ); for( @types ) { my( $abbr, $type, $link, $desc )= split " ", $_, 4; $type =~ tr/_/ /; my $id= getId( getType($type) ); $typeId{$type}= $id; $abbr{$type}= $abbr; $desc{$type}= $desc || $link; $link{ $id }= $link; $_= $type; } my %typeTable= qw( snippet snippet bookreview review modulereview review sourcecode sourcecode poll polls ); my %fieldOfTable= ( snippet => [qw( snippetdesc snippetcode )], review => [qw( itemdescription usercomment doctext )], sourcecode => [qw( codedescription doctext )], polls => ['choices'], #user => [qw( scratchpad )], # Needs to change ); my @sects; my $sects= do { my $negSects= ( $q->param("xs") )[-1] ? 1 : 0; my %checked; @checked{keys %abbr}= map { ( ()= $q->param($abbr{$_}) ) ? 1 : 0; } keys %abbr; @sects= grep $negSects != $checked{$_}, keys %abbr; @sects= @types if ! @sects; join ", ", map $typeId{$_}, @sects; }; my @criteria; my @users= grep length, $q->param("a"); if( 1 == @users && $users[0] =~ m#^(\s*\[[^\]]+\])+\s*$#g ) { @users= $users[0] =~ m#\[([^\]]+)\]#g; } for my $user ( @users ) { my $type = "user"; my $reason = "does not exist"; my $U; if( $user !~ m#^id://(\d+)$# ) { $U = getNode( $user, "user" ); } else { ( $type, $user ) = ( "node ID", $1 ); $U = getNodeById( $user ); if( $U && "user" ne $U->{type}{title} ) { undef $U; $reason = "is not a user"; } } if( $U ) { $user= getId($U); } else { $user= 0; push @errors, qq[\u$type "] . $query->escapeHTML($user) . qq[" $reason.
]; } } @users= grep $_, @users; my $negAuthor= ( $q->param("xa") )[-1] ? 1 : 0; $negAuthor= $negAuthor ? " NOT" : ""; if( @users ) { push @criteria, "n.author_user$negAuthor IN ( " . join( ", ", @users ) . " )"; } my $replies= ( $q->param("re") )[-1]; $q->param( "re", $replies ); my $xRoots= ()= $q->param("xr"); my $note= getId( getType("note") ); push @criteria, do { if( "N" eq $replies ) { # No replies: push @errors, "No root nodes and no replies means no search.
" if $xRoots; $xRoots ? "n.node_id = 0" # Find nothing! : "n.type_nodetype IN ( $sects )"; # Just sel. roots } elsif( "A" eq $replies # All replies (same as || @sects == @types ) { # re.s from all sect.s): $xRoots ? "n.type_nodetype = $note" #Just all re.s : "n.type_nodetype IN ( $note, $sects )";#^ + sel. roots } else { # Replies from sel. sects: $q->param( "re", undef ); my $c= "( n.type_nodetype = $note" . " AND root.type_nodetype IN ( $sects ) )"; $xRoots ? $c # Sel. re.s : "( n.type_nodetype IN ( $sects ) OR $c )"; # ^ + roots } }; # ( Head Body ) + ( Includes Excludes ) + ( Terms Seperator ) my $getTerms= sub { my( $textParam, $sepParam )= @_; my $str= $q->param( $textParam ); my $sep= $q->param( $sepParam ); $sep =~ s/^\s*//; $sep =~ s/\s*$//; $sep= " " if ! length $sep; $q->param( $sepParam, $sep ); my @terms= grep length, split /\Q$sep/, $str; $q->param( $textParam, join $sep, @terms ); return @terms; }; my @headHas= $getTerms->( "HIT", "HIS" ); my @headLacks= $getTerms->( "HET", "HES" ); my @bodyHas= $getTerms->( "BIT", "BIS" ); my @bodyLacks= $getTerms->( "BET", "BES" ); my( @tables, @fields ); push @tables, 'note', "left join node as root on root.node_id=root_node"; if( @bodyHas || @bodyLacks ) { my( %tables, %fields ); push @sects, 'note' unless 'N' eq $replies; for my $type ( @sects ) { if( $typeTable{$type} ) { ++$tables{ $typeTable{$type} }; ++$fields{$_} for @{ $fieldOfTable{ $typeTable{$type} } }; } else { ++$tables{document}; ++$fields{doctext}; } } push @tables, keys %tables; push @fields, keys %fields; } my $tables= "node as n"; for my $table ( @tables ) { if( $table =~ / / ) { $tables .= "\n$table"; } else { $tables .= "\nleft join $table on ${table}_id=n.node_id"; } } if( @headHas ) { push @criteria, map { my $quoted= $_; $quoted =~ s#\\#\\\\#g; # MySQL bug $quoted =~ s#(['%_\\\[\]])#\\$1#g; "n.title LIKE '%$quoted%'"; } @headHas; } if( @headLacks ) { push @criteria, map { my $quoted= $_; $quoted =~ s#\\#\\\\#g; # MySQL bug $quoted =~ s#(['%_\\\[\]])#\\$1#g; "n.title NOT LIKE '%$quoted%'"; } @headLacks; } if( @bodyHas ) { push @criteria, map { my $quoted= $_; $quoted =~ s#\\#\\\\#g; # MySQL bug $quoted =~ s#(['%_\\\[\]])#\\$1#g; "( " . join( " OR ", map { "$_ LIKE '%$quoted%'"; } @fields ) . " )"; } @bodyHas; } if( @bodyLacks ) { push @criteria, map { my $quoted= $_; $quoted =~ s#\\#\\\\#g; # MySQL bug $quoted =~ s#(['%_\\\[\]])#\\$1#g; map { "$_ NOT LIKE '%$quoted%'"; } @fields; } @bodyLacks; } my $oldFirst= ! ( $q->param("nf") )[-1]; my $n0= $q->param("n0"); my $doSearch= $n0 && ! @errors; my $lastNode= $DB->sqlSelect( "max(node_id)", "node" ); $n0 ||= $oldFirst ? 1 : $DB->sqlSelect( "max(node_id)", "node" ); push @criteria, "n.node_id BETWEEN !TBD!"; my $limit= 50; if( $doSearch ) { require Time::HiRes; my @matches; my $start= $n0; my $startTime= Time::HiRes::time(); while( 1 ) { my( $min, $max ); if( $oldFirst ) { ( $min, $max )= ( $n0, $n0+10000 ); $max= 1000 * int( $max/1000 + 0.5 ); $max= $lastNode if $lastNode < $max; } else { ( $min, $max )= ( $n0-10000, $n0 ); $min= 1000 * int( $min/1000 + 0.5 ); $min= 1 if $min < 1; } $criteria[-1]= "n.node_id BETWEEN $min AND $max"; my $explainTime= Time::HiRes::time(); my $query= qq[ SELECT n.node_id, n.title, n.type_nodetype, n.author_user, n.createtime, root.type_nodetype FROM $tables WHERE ] . join( " AND ", @criteria ) . qq[ ORDER BY n.node_id LIMIT ] . ( $limit - @matches ); my $explain= $DB->getDatabaseHandle()->prepare( "EXPLAIN $query" ); $explain->execute(); my $rec= $explain->fetchrow_hashref(); $explain->finish(); my $key_used= $rec->{key}; my $key_rows= $rec->{rows}; my $comment= $rec->{Comment}; $explainTime= Time::HiRes::time() - $explainTime; if( 3 < $explainTime ) { push @errors, ( $start==$n0 ? "Q" : "Remainder of q" ) . qq[uery was not run; Server is too busy ] . sprintf( qq[("explain" took %.2f seconds)
], $explainTime ); last; } unless( "PRIMARY" eq $key_used or "" ne $key_used && $key_rows < 10000 ) { push @errors, ( $start==$n0 ? "Q" : "Remainder of q" ) . "uery would not run quickly" . ( $comment ? " ($comment)" : "" ) . ".
\n"; last; } my $cursor= $DB->sqlSelectMany( "n.node_id as node_id, n.title as title, n.type_nodetype as type_nodetype, n.author_user as author_user, n.createtime as createtime, root.type_nodetype as root_nodetype", $tables, join( " AND ", @criteria ), "ORDER BY n.node_id LIMIT " . ( $limit - @matches ), ); my $rec; while( $rec= $cursor->fetchrow_hashref() ) { push @matches, $rec; } $cursor->finish(); if( @matches < $limit ) { $n0= 1 + $max; } else { $n0= 1 + $matches[-1]{node_id}; last; } last if $lastNode < $n0; my $runTime= Time::HiRes::time() - $startTime; if( 10 < $runTime ) { push @errors, ( $start==$n0 ? "Q" : "Remainder of q" ) . qq[uery was not run ] . sprintf( qq[(used %.2f seconds so far)
], $runTime ); last; } } my $startDate= ( split " ", $DB->sqlSelect( "createtime","node","node_id=$start") )[0]; my $endDate= ( split " ", $DB->sqlSelect( "createtime","node","node_id=".($n0-1)) )[0]; my $matches= @matches; $html .= qq[


Found $matches node] . ( 1==$matches ? "" : "s" ) . qq[between IDs $start ($startDate) and ] . ($n0-1) . qq[($endDate)]; if( @bodyHas || @bodyLacks || @headHas || @headLacks ) { $html .= qq[
where ] . join qq[
and ], map { my( $desc, @terms )= @$_; if( ! @terms ) { (); } else { $desc . join( ", ", map { '"' . $q->escapeHTML($_) . '"' } @terms ) } } ["any text contains all of ",@bodyHas], ["no text contains any of ",@bodyLacks], ["title contains all of ",@headHas], ["title doesn't contain any of ",@headLacks], } if( @users ) { $html .= qq[
written by ] . ( $negAuthor ? "anyone but " : "any of " ) . join ", ", map linkNode($_), @users; } $html .= qq[

\n]; my $linkType= sub { my( $typeId )= @_; return linkNode( $typeId, $link{$typeId} ); }; $html .= qq[

]; for my $rec ( @matches ) { $html .= $q->Tr( $q->td( ( split " ", $rec->{createtime} )[0] ), $q->td( linkNode($rec->{author_user}) ), $q->td( linkNode($rec->{node_id},$rec->{title}) ), $q->td( $note == $rec->{type_nodetype} ? "Re:" . $linkType->( $rec->{root_nodetype} ) : $linkType->( $rec->{type_nodetype} ) ), ); } $html .= qq[

\n]; } $q->param( "n0", $n0 ); if( $doSearch ) { if( $oldFirst && $n0 < $lastNode || ! $oldFirst && 1 < $n0 ) { my( $min, $max )= $oldFirst ? ( $n0, $lastNode ) : ( 1, $n0 ); $html .= qq[

Press a "Search" button (below) to continue (IDs $min thru $max).

\n]; } $html .= "
"; } $html .= '

' . linkNode( $NODE, "Reset search form" ) . "

\n"; $html .= $/ . htmlcode('openform') . $/; $html .= qq[

Match text containing ] . $q->textfield( "BIT", "", 60 ) . qq[
(seperate strings with ] . $q->textfield( "BIS", " ", 2 ) . qq[ -- default is spaces)
] . $q->radio_group( "BH", [ "0", "1" ], "1", 0, { 0=>"Don't match -or-", 1=>"Also match" }, ) . qq[ titles against above.

]; $html .= $/ . $q->submit("","Search") . qq[ Please be patient after submitting your search.\n]; $html .= qq[

Match titles containing ] . $q->textfield( "HIT", "", 60 ) . qq[
(separate strings with ] . $q->textfield( "HIS", " ", 2 ) . qq[ -- default is spaces)

]; $html .= qq[

] . $q->radio_group( "xa", [ "0", "1" ], "0", 0, { 0=>"Match -or-", 1=>"Exclude" }, ) . qq[ authors ] . $q->textfield( "a", "", 20 ) . qq[
(use "[one] [two]" to list multiple authors)
(Searching by author doesn't work for Categorized Questions and Answers yet.)

]; $html .= qq[

Search ] . $q->radio_group( -name=>"nf", -values=>[ "1", "0" ], -default=>"0", -labels=>{ 1=>"Newest first -or-", 0=>"Oldest first" }, -disabled=>"disabled", ) . qq[,
starting at node ] . $q->textfield( "n0", "0", 12 ) . qq[ (] . ( split " ", $DB->sqlSelect( "createtime","node","node_id=$n0") )[0] . qq[).

]; $html .= qq[]; $html .= qq[

Search ] . $q->radio_group( "xs", [0,1], 0, 0, {0=>"only -or-",1=>"all but"}, ) . qq[
the following sections:]; $html .= qq[

\n]; $html .= qq[

Skip text containing ] . $q->textfield( "BET", "", 60 ) . qq[
(seperate strings with ] . $q->textfield( "BES", " ", 2 ) . qq[ -- default is spaces)
(Does not exclude based on titles)

]; $html .= qq[

Skip titles containing ] . $q->textfield( "HET", "", 60 ) . qq[
(seperate strings with ] . $q->textfield( "HES", " ", 2 ) . qq[ -- default is spaces)

]; $html .= qq[

\n] . $q->radio_group( "xr", ["0","1"], "0", 1, { 0 => "Include root nodes from selected sections", 1 => "Don't include root nodes", }, ); $html .= qq[

\n] . $q->radio_group( "re", [qw( A S N )], "S", 1, { A => "Include replies from any section", S => "Include replies from selected sections", N => "Don't include replies", }, ); $html .= qq[\n

] . $q->submit("","Search") . qq[ Please be patient after submitting your search.

\n]; $html .= qq[\n]; $html .= qq[\n\n]; return "@errors$html"; %]