Changeset 401

Timestamp:

06/13/04 15:07:18 (5 years ago)

Author:

kake

Message:

Added ability to search by distance from an arbitrary point specified in lat/long.

Location:

trunk

Files:

• Build.PL (modified) (1 diff)
• Changes (modified) (1 diff)
• MANIFEST (modified) (1 diff)
• PREREQUISITES (modified) (1 diff)
• lib/OpenGuides.pm (modified) (3 diffs)
• lib/OpenGuides/SuperSearch.pm (modified) (12 diffs)
• t/33_supersearch_advanced_search.t (added)
• templates/navbar.tt (modified) (1 diff)
• templates/supersearch.tt (modified) (2 diffs)
• wiki.cgi (modified) (1 diff)

trunk/Build.PL

@@ -229 +229 @@
         'CGI::Wiki::Plugin::Diff'         => 0,
         'CGI::Wiki::Plugin::GeoCache'     => 0,
-        'CGI::Wiki::Plugin::Locator::UK'  => '0.06',
+        'CGI::Wiki::Plugin::Locator::UK'  => '0.09',
         'CGI::Wiki::Plugin::RSS::ModWiki' => '0.02',
         'CGI::Wiki::Plugin::RSS::Reader'  => '1.3',  # earlier versions don't support RSS 2.0

trunk/Changes

@@ -6 +6 @@
           links being displayed for nodes with no address data (spotted
           by Steve Jolly).
-        Remove inline style from recent_changes.tt. You will need to add
+        Removed inline style from recent_changes.tt. You will need to add
           the styles table#recentchanges, td.recentchanges_meta,
           td.recentchanges_user, td.recentchanges_node_name and
           td.recentchanges_comment to your stylesheets.
+        Added searching by distance from an arbitrary point (click on
+          Advanced Search).
+        Internal rejigging - extracted some methods from wiki.cgi to
+          OpenGuides.pm.
 
 0.32    7 June 2004

trunk/MANIFEST

@@ -56 +56 @@
 t/31_supersearch.t
 t/32_supersearch_simple_metadata.t
+t/33_supersearch_advanced_search.t
 t/41_deletion.t
 t/51_display_node.t

trunk/PREREQUISITES

@@ -11 +11 @@
 CGI::Wiki::Plugin::Diff
 CGI::Wiki::Plugin::GeoCache
-CGI::Wiki::Plugin::Locator::UK (version 0.06 or later)
+CGI::Wiki::Plugin::Locator::UK (version 0.09 or later)
 CGI::Wiki::Plugin::RSS::ModWiki (version 0.02 or later)
 CGI::Wiki::Plugin::RSS::Reader (version 1.3 or later)

trunk/lib/OpenGuides.pm

@@ -13 +13 @@
 use vars qw( $VERSION );
 
-$VERSION = '0.33_05';
+$VERSION = '0.33_06';
 
 =head1 NAME
@@ -303 +303 @@
     my $metres = $args{metres};
     my $formatter = $self->wiki->formatter;
-
     my @finds = $self->locator->find_within_distance(
                                                       node   => $node,
@@ -333 +332 @@
                                    id       => "index", # KLUDGE
                                    template => "site_index.tt",
-                                   vars     => \%tt_vars,
+                                   tt_vars  => \%tt_vars,
                                  );
 }

trunk/lib/OpenGuides/SuperSearch.pm

@@ -1 +1 @@
 package OpenGuides::SuperSearch;
 use strict;
-our $VERSION = '0.04';
+our $VERSION = '0.05';
 
 use CGI qw( :standard );
+use CGI::Wiki::Plugin::Locator::UK;
 use File::Spec::Functions qw(:ALL);
 use OpenGuides::Template;
@@ -53 +54 @@
     $self->{css}      = $config->{_}{stylesheet_url};
     $self->{head}     = $config->{_}{site_name} . " Search";
+
+    my $locator = CGI::Wiki::Plugin::Locator::UK->new;
+    $wiki->register_plugin( plugin => $locator );
+    $self->{locator} = $locator;
 
     return $self;
@@ -92 +97 @@
     $tt_vars{ss_info_url} = 'http://london.openguides.org/?Search_Script';
 
+    # Strip out any non-digits from dist; lat and long also allowed '-' and '.'
+    $vars{lat} =~ s/[^-\.0-9]//g;
+    $vars{long} =~ s/[^-\.0-9]//g;
+    $vars{distance_in_metres} =~ s/[^0-9]//g;
+
     # Do we have an existing search? if so, do it.
-    if ( $vars{search} ) {
+    my $doing_search;
+    if ( $vars{search}
+         or ( defined $vars{lat}
+              && defined $vars{long}
+              && defined $vars{distance_in_metres} )
+    ) {
+        $doing_search = 1;
         $tt_vars{search_terms} = $vars{search};
+        $tt_vars{lat} = $vars{lat};
+        $tt_vars{long} = $vars{long};
+        $tt_vars{dist} = $vars{distance_in_metres};
         $self->_perform_search( vars => \%vars );
     }
@@ -100 +119 @@
     if ( $self->{error} ) {
         $tt_vars{error_message} = $self->{error};
-    } elsif ( $vars{search} ) {
-        my %results = %{ $self->{results} || {} };
-        my $numres = scalar keys %results;
+    } elsif ( $doing_search ) {
+        my @results = values %{ $self->{results} || {} };
+        my $numres = scalar @results;
 
         # For 0 or many we display results, for 1 we redirect to that page.
         if ( $numres == 1 && !$self->{return_tt_vars}) {
-            my ($node) = each %results;
+            my $node = $results[0]{name};
             my $output = CGI::redirect( $self->{wikimain} . "?"
                                         . CGI::escape($node) );
@@ -127 +146 @@
             }
 
-            # Sort the results - first index of array in HoA is the score.
-            my @res_selected = sort
-                               { $results{$b}[0] <=> $results{$a}[0] }
-                               keys %results;
+            # Sort the results - by distance if we're searching on that
+            # or by score otherwise.
+            if ( $vars{distance_in_metres} ) {
+                @results = sort { $a->{distance} <=> $b->{distance} } @results;
+            } else {
+                @results = sort { $a->{score} <=> $b->{score} } @results;
+            }
 
             # Now snip out just the ones for this page.  The -1 is
@@ -136 +158 @@
             my $from = $tt_vars{first_num} ? $tt_vars{first_num} - 1 : 0;
             my $to   = $tt_vars{last_num} - 1; # kludge to empty arr for no res
-            @res_selected = @res_selected[ $from .. $to ];
-
-            my @result_urls;
-            foreach ( @res_selected ) {
-                my @summary = grep { defined $_ } @{$results{$_}}[1 .. 6];
-                push @result_urls,
-                  {
-                    name    => $_,
-                    url     => $self->{wikimain} . "?" . CGI::escape($_),
-                    summary => join "\n", @summary,
-                  };
-            }
-            $tt_vars{results} = \@result_urls;
+            @results = @results[ $from .. $to ];
+
+            $tt_vars{results} = \@results;
         }
     }
@@ -262 +274 @@
     my ($self, %args) = @_;
     my %vars = %{ $args{vars} || {} };
+
     my $srh = $vars{search};
 
-    # Check for only valid characters in tainted search param
-    # (quoted literals are OK, as they are escaped)
-    if ( $srh !~ /^("[^"]*"|[\w \-',()!*%\[\]])+$/i) { #"
-        $self->{error} = "Search expression contains invalid character(s)";
-        return;
-    }
-
-    $self->_build_parser && exists($self->{error}) && return;
-    $self->_apply_parser($srh);
+    # Perform text search if search terms entered, otherwise collect up
+    # all nodes to check distance.
+    if ( $srh ) {
+        # Check for only valid characters in tainted search param
+        # (quoted literals are OK, as they are escaped)
+        if ( $srh !~ /^("[^"]*"|[\w \-',()!*%\[\]])+$/i) { #"
+            $self->{error} = "Search expression contains invalid character(s)";
+            return;
+        }
+        $self->_build_parser && exists($self->{error}) && return;
+        $self->_apply_parser($srh);
+    } else {
+        my @all_nodes = $self->{wiki}->list_all_nodes;
+        my $formatter = $self->{wiki}->formatter;
+        my %results = map {
+              my $name = $formatter->node_name_to_node_param( $_ );
+              $name => {
+                         name    => $name,
+                         score   => 0,
+                         summary => "FIXME",
+                       }
+                          } @all_nodes;
+        $self->{results} = \%results;
+    }
+
+    # Now filter by distance if required.
+    my ($lat, $long, $dist) = @vars{ qw( lat long distance_in_metres ) };
+    if ( defined $lat && defined $long && $dist ) {
+        my %results = %{ $self->{results} || {} };
+        my @close = $self->{locator}->find_within_distance(
+                                                            lat    => $lat,
+                                                            long   => $long,
+                                                            metres => $dist,
+                                                          );
+        my %close_hash = map { $_ => 1 } @close;
+        my @nodes = keys %results;
+        foreach my $node ( @nodes ) {
+            my $unmunged = $node; # KLUDGE
+            $unmunged =~ s/_/ /g;
+            if ( exists $close_hash{$unmunged} ) {
+                my $distance = $self->{locator}->distance(
+                                                 from_lat  => $lat,
+                                                 from_long => $long,
+                                                 to_node   => $unmunged,
+                                                 unit      => "metres"
+                                                         );
+                $results{$node}{distance} = $distance;                
+            } else {
+                delete $results{$node};
+            }
+        }
+        $self->{results} = \%results;
+    }      
 }
 
@@ -341 +398 @@
     my $op = shift @tree_arr;
     my $meth = 'matched_'.$op;
-
     return $self->can($meth) ? $self->$meth(@tree_arr) : undef;
 }
@@ -382 +438 @@
 
 sub matched_AND {
-    my $self = shift;
-
-    # Do all the searches
-    my @comby_res = map {
-                          my %match_hash = $self->_matched_items(tree => $_);
-                          \%match_hash
-                        } @_;
-
-    # Use the first one's results as a basis for the output hash
-    my @out = keys %{$comby_res[0]};
-    my %out;
-
-    # Zap out any entries which do not appear in one of the other searches.
-    PAGE:
-    for my $page (@out) {
-        for (@comby_res[1..$#comby_res]) {
-            (delete $out{$page}),next PAGE if !exists $_->{$page};
-        }
-        
-        $out{$page} = $self->intersperse($page, @comby_res);
-    }
-    
-    return %out;
+    my ($self, @subsearches) = @_;
+
+    # Do the first subsearch.
+    my %results = $self->_matched_items( tree => $subsearches[0] );
+
+    # Now do the rest one at a time and remove from the results anything
+    # that doesn't come up in each subsearch.  Results that survive will
+    # have a score that's the sum of their score in each subsearch.
+    foreach my $tree ( @subsearches[ 1 .. $#subsearches ] ) {
+        my %subres = $self->_matched_items( tree => $tree );
+        my @pages = keys %results;
+        foreach my $page ( @pages ) {
+            if ( exists $subres{$page} ) {
+                $results{$page}{score} += $subres{$page};
+            } else {
+                delete $results{$page};
+            }
+        }
+    }
+
+    return %results;
 }
 
@@ -420 +474 @@
 
 sub matched_OR {
-    my $self = shift;
-
-    # Do all the searches
-    my @list_res = map {
-                         my %match_hash = $self->_matched_items(tree => $_);
-                         \%match_hash
-                       } @_;
-
-    # Apply union of hashes, merging any duplicates.
-    my %union;
-    for (@list_res) {
-        while (my ($k,$v) = each %$_) {
-            $union{$k}++;
+    my ($self, @subsearches) = @_;
+
+    # Do all the searches.  Results will have a score that's the sum
+    # of their score in each subsearch.
+    my %results;
+    foreach my $tree ( @subsearches ) {
+        my %subres = $self->_matched_items( tree => $tree );
+        foreach my $page ( keys %subres ) {
+            if ( $results{$page} ) {
+                $results{$page}{score} += $subres{$page}{score};
+            } else {
+                $results{$page} = $subres{$page};
+            }
         }
     }
-    
-    my %out;
-    
-    $out{$_} = $self->intersperse($_, @list_res) for keys %union;
-    
-    return %out;
-}
-
+    return %results;
+}
 
 =item B<NOT searches>
@@ -513 +561 @@
     # context either side.
     my $wexp = qr/\b.{0,60}\b$wmatch\b.{0,60}\b/is;
-    my %res;
+    my %results;
 
     # Search every wiki page for matches
@@ -528 +576 @@
         $temp =~ s/_/ /g;
 
-        # Compute score and prepend to array of matches
-        my $score = @out;
+        # Compute score and create summary.
+        my $score = scalar @out;
         $score +=10 if $temp =~ /$wexp/;
-        $res{$k} = unshift(@out,$score) && \@out if @out;
-    }
-    
-    return %res;
+        $results{$k} = {
+                         score   => $score,
+                         summary => join( "", @out ),
+                         name    => $k,
+                       }
+          if $score;
+    }
+    
+    return %results;
 }
 

trunk/templates/navbar.tt

@@ -38 +38 @@
       </form>
     </div>
+    <div class="navbar_item">
+      <a href="supersearch.cgi">Advanced Search</a>
+    </div>
   </div>
 

trunk/templates/supersearch.tt

@@ -24 +24 @@
 
   <form method="get" action="supersearch.cgi">
-    <label for="search_upper">Search:</label> 
+    <label for="search_upper">Search text:</label> 
     <input type="text" name="search" value="[% search_terms %]" size="50" maxlength="80" id="search_upper" value="Search text" onclick="this.value=''" />
+    <br />
+    Located within
+    <input type="text" name="distance_in_metres" value="[% dist %]" size="4" maxlength="4" />
+    metres of
+    latitude <input type="text" name="lat" value="[% lat %]" size="10" maxlength="10" />
+    longitude <input type="text" name="long" value="[% long %]" size="10" maxlength="10" />
+    <br />
     <input type="submit" name="go" class="form_button" value="Go" />
   </form>
@@ -38 +45 @@
         [% FOREACH result = results %]
           <li>
-            <a href="[% result.url %]"><b>[% result.name.replace('_', ' ') %]</b></a>
+            <a href="[% full_cgi_url %]?[% result.name %]"><b>[% result.name.replace('_', ' ') %]</b></a>
+            [% IF result.distance %]
+              ([% result.distance %] metres away)
+            [% END %]
             <br />
             [% result.summary %]

trunk/wiki.cgi

@@ -5 +5 @@
 
 use vars qw( $VERSION );
-$VERSION = '0.33_05';
+$VERSION = '0.33_06';
 
 use CGI qw/:standard/;