Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??

The only modules are DBI, CGI, and Everything. Most of the actual code is included below.

This is a pretty specialized situation. For example, we can't allow any single query to run very long since MySQL was designed assuming some aspects of the threading model (light-weight processes) that aren't present on FreeBSD. So a single long-running query can nearly lock up access to the database for everyone.

Another MySQL quirk is that even when you use DBI, once you submit a query MySQL does the whole dang thing before it lets you get the first matching record back. If it weren't for this quirk, I could work around the previous problem (in many cases) by terminating the long-running query after I'd fetched enough records (or taken too much time). But I can't, so I have to ensure that each query will finish fairly quickly in all cases.

And we tried using MySQL's "full-text search" features. I pretty much hated the results (can't search for 3-letter words, for example). But worse, it still had "worst case" situations where a single search could end up locking up the whole site.

I remember my first run-ins with full-text search (in the '80s). It sounds so nice but in practice I find that it rarely works very well. It usually takes lots and lots of practice to learn how to do a decent search that gives you back something you are looking for but not buried amid 4000 things you don't want.

Well, I haven't noticed it get much better. Sure, there are some "words" that are unique enough that searching on them works great. But way too much of the time you don't get that lucky. I find that I almost always prefer searching an index than trying my luck at "full-text search".

Except, of course, for Google! The miracle of Google is how they sort the results. Trying to imitate Google's ingenious sorting technique (what we know of it) seemed like too much work for me to pull off in my spare time.

Now, we can use Google. But I've tried using Google against PerlMonks (directly and through "thepen") and it just doesn't work that well.

And lots of times I don't want to search for "words". Even Google doesn't do a very good job if you want to search for parts of "words". It does pretty good at search for "phrases". But throw lots of punctuation in and it and I often don't agree on what a "word" is. And Perl code certain often has lots of punctuation in it.

So I realy liked the original PerlMonks simple and Super searches. They were pretty much just substring searches that required "and" (match all of the criteria listed). I found that I was successful with them much more frequently than I am with full-text searches. But, they are resource intensive.

So I've heard quite a few people's suggestions on ways to build a word lists and lists of "stop" words that you aren't allowed to search for, etc. to roll our own full-text search. Or some canned full-text search to use. Well, I encourage anyone who wants to to pursue such. We've even added XML tickers so external search engines can be built more easily. But I doubt I will find them very useful. (BTW, my quick glance at DBIx::FullTextSearch makes me think it wants to create its own tables so you might want to try making an external search out of it -- if it turns out nice, we can probably find a place to host it.)

Anyway, in trying to find out why the site was locking up, I made changes to "mytop" (like "top" but for MySQL queries -- it shows the current queries against database and how long they've been running) and did lots of watching and fixing. And I've come to understand some of what makes a query slow in MySQL.

I kind of like MySQL's query optimizer. It is quite simple (compared to some of the ones I deal with) and so it is much easier to predict what it is going to do. I spent years writing database code where we didn't use SQL, we would seek to a point in an index and read forward or backward from there. So I think of ways to get results efficiently at a low level. But sometimes it is dang hard to write SQL that convinces the optimizer to do what I thought up (so, somewhat paradoxically, a query that I could perform very efficiently will be executed very inefficiently by the SQL server).

So, the basic lesson in this case is that you want to make a query that can find all of the records that it needs by searching a fairly small range of one index and then set a reasonable LIMIT. Then you have to tell SQL to order the records based on that index (that makes it much more likely that the optimizer will actually choose to use the index that you gave to it on a silver platter).

Of course, many queries can't be fullfilled that way so I end up findng the matches by doing a sequence of such queries.

If you don't specify a small range, then you could spend too much time searching a large number of records (and the optimizer also "understands" this and so becomes more likely to ignore your preferred index) which would lock up MySQL on FreeBSD (a joke user someone made for me when I started blaming all site problems on this combination). And you have to set a reasonable LIMIT or else you could spend too much time sending the matching information across (with the same result). And since you specified the sort order, you can also efficiently continue where you left off (without having to use something like MySQL's "LIMIT 50,150" which probably requires the first part of the search basically be repeated).

So that is what the newest Super Search does. And, just in case I don't know the MySQL optimizer as well as I think I do, it asks the optimizer to explain its plan before letting MySQL try to perform the query. If it doesn't decide to use an index that requires only a fairly small number of records to be read, then I won't run the query.

I've made some fairly minor changes to the code and removed some code that is just for future features in hopes of it being slightly easier to understand. Some changes are things I planned to do to clean up the code but I just did them quickly here and haven't tested. So if you see a syntax error, it is probably just a typo. /:

Also, writing code for Everything makes it hard to write utility subroutines so this isn't really "factored" like I would normally write code. Okay, enough excuses. ;)

Update: I forgot one excuse. (: The CGI parameters names were chosen to be very short (but still somewhat mnemonic) because I plan to add a feature where you can cut'n'paste a URL that performs the search that you have crafted for repeating it later or referring to it in a node, etc.

        - tye (but my friends call me "Tye")
[% 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.<br />]; } } @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.<br />" 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)<br />], $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)" : "" ) . ".<br />\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 createt +ime, 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)<br />], $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[<p><hr /> <b>Found $matches node] . ( 1==$matches ? "" : "s" ) . qq[</b>between IDs $start ($startDate) and ] . ($n0-1) . qq[($endDate)]; if( @bodyHas || @bodyLacks || @headHas || @headLacks ) { $html .= qq[<br />where ] . join qq[<br />and ], map { my( $desc, @terms )= @$_; if( ! @terms ) { (); } else { $desc . join( ", ", map { '"<tt>' . $q->escapeHTML($_) . '</tt>"' } @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[<br />written by ] . ( $negAuthor ? "anyone but " : "any of " ) . join ", ", map linkNode($_), @users; } $html .= qq[</p>\n]; my $linkType= sub { my( $typeId )= @_; return linkNode( $typeId, $link{$typeId} ); }; $html .= qq[<p><table width="100%">]; 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[</table></p>\n]; } $q->param( "n0", $n0 ); if( $doSearch ) { if( $oldFirst && $n0 < $lastNode || ! $oldFirst && 1 < $n0 ) { my( $min, $max )= $oldFirst ? ( $n0, $lastNode ) : ( 1, $n0 ); $html .= qq[<p> Press a "Search" button (below) <b>to continue</b> (IDs $min thru $max). </p>\n]; } $html .= "<hr />"; } $html .= '<p>' . linkNode( $NODE, "Reset search form" ) . "</p>\n" +; $html .= $/ . htmlcode('openform') . $/; $html .= qq[<p> Match <b>text</b> containing ] . $q->textfield( "BIT", "", 60 +) . qq[<br />(seperate strings with ] . $q->textfield( "BIS", " ", 2 ) . qq[ -- default is spaces) <br />] . $q->radio_group( "BH", [ "0", "1" ], "1", 0, { 0=>"Don't match -or-", 1=>"Also match" }, ) . qq[ <b>titles</b> against above.</p>]; $html .= $/ . $q->submit("","Search") . qq[ Please be patient after submitting your search.\n]; $html .= qq[<p> Match <b>titles</b> containing ] . $q->textfield( "HIT", "", 60 ) . qq[<br />(separate strings with ] . $q->textfield( "HIS", " ", 2 ) . qq[ -- default is spaces)</p>]; $html .= qq[<p> ] . $q->radio_group( "xa", [ "0", "1" ], "0", 0, { 0=>"Match -or-", 1=>"Exclude +" }, ) . qq[ <b>authors</b> ] . $q->textfield( "a", "", 20 ) . qq[<br /> (use "&#91;one&#93; &#91;two&#93;" to list multiple authors) <br />(Searching by author doesn't work for Categorized Questions and Answers yet.)</p>]; $html .= qq[<p> Search ] . $q->radio_group( -name=>"nf", -values=>[ "1", "0" ], -default=>"0", -labels=>{ 1=>"Newest first -or-", 0=>"Oldest first" }, -disabled=>"disabled", ) . qq[,<br />starting at node ] . $q->textfield( "n0", "0", 12 ) . qq[ (] . ( split " ", $DB->sqlSelect( "createtime","node","node_id=$n0") )[0] . qq[).</p>]; $html .= qq[<!-- <p> Show {10|20|50} matches per page.</p> -->]; $html .= qq[<p> Search ] . $q->radio_group( "xs", [0,1], 0, 0, {0=>"only -or-",1=>"all but"}, ) . qq[<br />the following <b>sections</b>:]; $html .= qq[<ul>] . $q->table( map( "\n " . $q->Tr( map "\n " . $q->td( $q->checkbox( -name => $abbr{$types[$_]}, -value => "", -label => $desc{$types[$_]}, "scratchpad" eq $types[$_] ? ( -disabled => "disabled" ) : (), ) ), @$_ ), map( [ $_, $_+8, $_+16 ], 0..6 ), [7,15] ), $/ ) . qq[</ul>\n]; $html .= qq[<p> <i>Skip</i> <b>text</b> containing ] . $q->textfield( "BET", "", 60 ) . qq[<br />(seperate strings with ] . $q->textfield( "BES", " ", 2 ) . qq[ -- default is spaces)<br /> (Does not exclude based on titles)</p>]; $html .= qq[<p> <i>Skip</i> <b>titles</b> containing ] . $q->textfield( "HET", "", 60 ) . qq[<br />(seperate strings with ] . $q->textfield( "HES", " ", 2 ) . qq[ -- default is spaces)</p>]; $html .= qq[</p><p>\n] . $q->radio_group( "xr", ["0","1"], "0", 1, { 0 => "Include <b>root</b> nodes from selected sections", 1 => "Don't include <b>root</b> nodes", }, ); $html .= qq[</p><p>\n] . $q->radio_group( "re", [qw( A S N )], "S", 1, { A => "Include <b>replies</b> from <i>any</i> section", S => "Include <b>replies</b> from <i>selected</i> sections +", N => "<i>Don't</i> include <b>replies</b>", }, ); $html .= qq[\n<p>] . $q->submit("","Search") . qq[ Please be patient after submitting your search.</p>\n]; $html .= qq[</form>\n]; $html .= qq[\n<!-- CGI::VERSION=$CGI::VERSION -->\n]; return "<b>@errors</b>$html"; %]

In reply to (tye)Re: Newest Super Search by tye
in thread Newest Super Search by tye

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others imbibing at the Monastery: (6)
    As of 2014-07-13 15:38 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      When choosing user names for websites, I prefer to use:








      Results (250 votes), past polls