#!/opt/csw/bin/perl use strict; use warnings; use CGI qw( :standard ); use CGI::Carp qw( fatalsToBrowser ); use OpenGuides; use OpenGuides::Config; use Wiki::Toolkit::Plugin::Locator::Grid; my $config_file = $ENV{OPENGUIDES_CONFIG_FILE} || "wiki.conf"; my $config = OpenGuides::Config->new( file => $config_file ); my $guide = OpenGuides->new( config => $config ); my $wiki = $guide->wiki; my $locator = Wiki::Toolkit::Plugin::Locator::Grid->new( x => "os_x", y => "os_y" ); $wiki->register_plugin( plugin => $locator ); my $formatter = $wiki->formatter; my $q = CGI->new; print $q->header; my $self_url = $q->url( -relative ); print < Randomness guide Kakesearch

Randomness guide Kakesearch

EOHTML print_form(); if ( $q->param( "do_search" ) ) { my $cat1 = $q->param( "cat1" ); my $cat2 = $q->param( "cat2" ); my $dist = $q->param( "distance" ); $dist ||= 0; $dist =~ s/[^0-9]//g; if ( !$dist || !$cat1 || !$cat2 ) { print "

Must supply both categories, and a distance.

"; } else { my $dbh = $wiki->store->dbh; my $sql = " SELECT node.id, node.name, mx.metadata_value as x, my.metadata_value as y FROM node INNER JOIN metadata as mc ON ( node.id=mc.node_id AND node.version=mc.version AND lower(mc.metadata_type)='category' AND lower(mc.metadata_value)=?) INNER JOIN metadata as mx ON ( node.id=mx.node_id AND node.version=mx.version AND lower(mx.metadata_type)='os_x' ) INNER JOIN metadata as my ON ( node.id=my.node_id AND node.version=my.version AND lower(my.metadata_type)='os_y' ) ORDER BY node.name "; my $sth = $dbh->prepare( $sql ); my @cat1stuff; my @cat2stuff; $sth->execute( lc( $cat1 ) ) or die $dbh->errstr; while ( my ( $id, $name, $x, $y ) = $sth->fetchrow_array ) { push @cat1stuff, { id => $id, name => $name, x => $x, y => $y }; } $sth->execute( lc( $cat2 ) ) or die $dbh->errstr; while ( my ( $id, $name, $x, $y ) = $sth->fetchrow_array ) { push @cat2stuff, { id => $id, name => $name, x => $x, y => $y }; } my @results; foreach my $origin ( @cat1stuff ) { my @thisres; foreach my $end ( @cat2stuff ) { my $thisdist = int( sqrt( ( $origin->{x} - $end->{x} )**2 + ( $origin->{y} - $end->{y} )**2 ) + 0.5 ); if ( $thisdist <= $dist ) { push @thisres, { origin => $origin, end => $end, dist => $thisdist }; } } @thisres = sort { $a->{dist} <=> $b->{dist} } @thisres; push @results, @thisres; } if ( @results == 0 ) { print "

No results, sorry.

"; } else { my $base_url = $config->script_url . $config->script_name . "?"; my $last_origin = ""; print "\n" . "" . "\n"; foreach my $set ( @results ) { my $origin_name = $set->{origin}->{name}; my $end_name = $set->{end}->{name}; my $origin_url = $base_url . $formatter->node_name_to_node_param( $origin_name ); my $end_url = $base_url . $formatter->node_name_to_node_param( $end_name ); print "\n"; if ( $last_origin ne $origin_name ) { print "\n"; } else { print "\n"; } print "\n" . "\n" . "\n"; $last_origin = $origin_name; } print "
$cat1$cat2Distance (metres)
$origin_name $end_name" . $set->{dist} . "
\n"; } } } print < EOHTML sub print_form { my $any_string = " -- any -- "; my @categories = $wiki->list_nodes_by_metadata( metadata_type => "category", metadata_value => "category", ignore_case => 1, ); @categories = map { s/^Category //; $_; } @categories; @categories = sort( @categories ); my $catbox1 = $q->popup_menu( -name => "cat1", -values => [ "", @categories ], -labels => { "" => $any_string, map { $_ => $_ } @categories } ); my $catbox2 = $q->popup_menu( -name => "cat2", -values => [ "", @categories ], -labels => { "" => $any_string, map { $_ => $_ } @categories } ); my $distbox = qq( param( "distance" ) ) { $distbox .= "value=\"" . $q->param( "distance" ) . "\""; } $distbox .= "> metres "; print <

Find me things in category $catbox1 within $distbox of things in category $catbox2.

EOHTML }