source: wiki-toolkit-plugin-locator-grid/trunk/lib/Wiki/Toolkit/Plugin/Locator/Grid.pm @ 326

Last change on this file since 326 was 326, checked in by Dominic Hargreaves, 14 years ago

Increment version and release

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 9.0 KB
Line 
1package Wiki::Toolkit::Plugin::Locator::Grid;
2
3use strict;
4
5use vars qw( $VERSION @ISA );
6$VERSION = '0.05';
7
8use Carp qw( croak );
9use Wiki::Toolkit::Plugin;
10
11@ISA = qw( Wiki::Toolkit::Plugin );
12
13=head1 NAME
14
15Wiki::Toolkit::Plugin::Locator::Grid - A Wiki::Toolkit plugin to manage co-ordinate data.
16
17=head1 DESCRIPTION
18
19Access to and calculations using co-ordinate metadata supplied to a
20Wiki::Toolkit wiki when writing a node.
21
22B<Note:> This is I<read-only> access. If you want to write to a node's
23metadata, you need to do it using the C<write_node> method of
24L<Wiki::Toolkit>.
25
26We assume that the points are located on a flat, square grid with unit
27squares of side 1 metre.
28
29=head1 SYNOPSIS
30
31  use Wiki::Toolkit;
32  use Wiki::Toolkit::Plugin::Locator::Grid;
33
34  my $wiki = Wiki::Toolkit->new( ... );
35  my $locator = Wiki::Toolkit::Plugin::Locator::Grid->new;
36  $wiki->register_plugin( plugin => $locator );
37
38  $wiki->write_node( "Jerusalem Tavern", "A good pub", $checksum,
39                     { x => 531674, y => 181950 } ) or die "argh";
40
41  # Just retrieve the co-ordinates.
42  my ( $x, $y ) = $locator->coordinates( node => "Jerusalem Tavern" );
43
44  # Find the straight-line distance between two nodes, in metres.
45  my $distance = $locator->distance( from_node => "Jerusalem Tavern",
46                                     to_node   => "Calthorpe Arms" );
47
48  # Find all the things within 200 metres of a given place.
49  my @others = $locator->find_within_distance( node   => "Albion",
50                                               metres => 200 );
51
52  # Maybe our wiki calls the x and y co-ordinates something else.
53  my $locator = Wiki::Toolkit::Plugin::Locator::Grid->new(
54                                                       x => "os_x",
55                                                       y => "os_y",
56                                                     );
57
58=head1 METHODS
59
60=over 4
61
62=item B<new>
63
64  # By default we assume that x and y co-ordinates are stored in
65  # metadata called "x" and "y".
66  my $locator = Wiki::Toolkit::Plugin::Locator::Grid->new;
67
68  # But maybe our wiki calls the x and y co-ordinates something else.
69  my $locator = Wiki::Toolkit::Plugin::Locator::Grid->new(
70                                                       x => "os_x",
71                                                       y => "os_y",
72                                                     );
73
74=cut
75
76sub new {
77    my $class = shift;
78    my $self = {};
79    bless $self, $class;
80    return $self->_init( @_ );
81}
82
83sub _init {
84    my ($self, %args) = @_;
85    $self->{x} = $args{x} || "x";
86    $self->{y} = $args{y} || "y";
87    return $self;
88}
89
90=item B<x_field>
91
92  my $x_field = $locator->x_field;
93
94An accessor, returns the name of the metadata field used to store the
95x-coordinate.
96
97=cut
98
99sub x_field {
100    my $self = shift;
101    return $self->{x};
102}
103
104=item B<y_field>
105
106  my $y_field = $locator->y_field;
107
108An accessor, returns the name of the metadata field used to store the
109y-coordinate.
110
111=cut
112
113sub y_field {
114    my $self = shift;
115    return $self->{y};
116}
117
118=item B<coordinates>
119
120  my ($x, $y) = $locator->coordinates( node => "Jerusalem Tavern" );
121
122Returns the x and y co-ordinates stored as metadata last time the node
123was written.
124
125=cut
126
127sub coordinates {
128    my ($self, %args) = @_;
129    my $store = $self->datastore;
130    # This is the slightly inefficient but neat and tidy way to do it -
131    # calling on as much existing stuff as possible.
132    my %node_data = $store->retrieve_node( $args{node} );
133    my %metadata  = %{$node_data{metadata}};
134    return ($metadata{$self->{x}}[0], $metadata{$self->{y}}[0]);
135}
136
137=item B<distance>
138
139  # Find the straight-line distance between two nodes, in metres.
140  my $distance = $locator->distance( from_node => "Jerusalem Tavern",
141                                     to_node   => "Calthorpe Arms" );
142
143  # Or in kilometres, and between a node and a point.
144  my $distance = $locator->distance( from_x  => 531467,
145                                     from_y  => 183246,
146                                     to_node => "Duke of Cambridge",
147                                     unit    => "kilometres" );
148
149Defaults to metres if C<unit> is not supplied or is not recognised.
150Recognised units at the moment: C<metres>, C<kilometres>.
151
152Returns C<undef> if one of the endpoints does not exist, or does not
153have both co-ordinates defined. The C<node> specification of an
154endpoint overrides the x/y co-ords if both specified (but don't do
155that).
156
157B<Note:> Works to the nearest metre. Well, actually, calls C<int> and
158rounds down, but if anyone cares about that they can send a patch.
159
160=cut
161
162sub distance {
163    my ($self, %args) = @_;
164
165    $args{unit} ||= "metres";
166    my (@from, @to);
167
168    if ( $args{from_node} ) {
169        @from = $self->coordinates( node => $args{from_node} );
170    } elsif ( $args{from_x} and $args{from_y} ) {
171        @from = @args{ qw( from_x from_y ) };
172    }
173
174    if ( $args{to_node} ) {
175        @to = $self->coordinates( node => $args{to_node} );
176    } elsif ( $args{to_x} and $args{to_y} ) {
177        @to = @args{ qw( to_x to_y ) };
178    }
179
180    return undef unless ( $from[0] and $from[1] and $to[0] and $to[1] );
181
182    my $metres = int( sqrt(   ($from[0] - $to[0])**2
183                            + ($from[1] - $to[1])**2 ) + 0.5 );
184
185    if ( $args{unit} eq "metres" ) {
186        return $metres;
187    } else {
188        return $metres/1000;
189    }
190}
191
192=item B<find_within_distance>
193
194  # Find all the things within 200 metres of a given place.
195  my @others = $locator->find_within_distance( node   => "Albion",
196                                               metres => 200 );
197
198  # Or within 200 metres of a given location.
199  my @things = $locator->find_within_distance( x      => 530774,
200                                               y      => 182260,
201                                               metres => 200 );
202
203Units currently understood: C<metres>, C<kilometres>. If both C<node>
204and C<x>/C<y> are supplied then C<node> takes precedence. Croaks if
205insufficient start point data supplied.
206
207=cut
208
209sub find_within_distance {
210    my ($self, %args) = @_;
211    my $store = $self->datastore;
212    my $dbh = eval { $store->dbh; }
213      or croak "find_within_distance is only implemented for database stores";
214    my $metres = $args{metres}
215               || ($args{kilometres} * 1000)
216               || croak "Please supply a distance";
217    my ($sx, $sy);
218    if ( $args{node} ) {
219        ($sx, $sy) = $self->coordinates( node => $args{node} );
220    } elsif ( $args{x} and $args{y} ) {
221        ($sx, $sy) = @args{ qw( x y ) };
222    } else {
223        croak "Insufficient start location data supplied";
224    }
225
226    # Only consider nodes within the square containing the circle of
227    # radius $distance.  The SELECT DISTINCT is needed because we might
228    # have multiple versions in the table.
229    my $sql = "SELECT DISTINCT x.name ".
230                          "FROM node AS x ".
231                          "INNER JOIN metadata AS mx ".
232                          "   ON (mx.node_id = x.id AND mx.version = x.version) ".
233                          "INNER JOIN node AS y ".
234                          "   ON (x.id = y.id) ".
235                          "INNER JOIN metadata my ".
236              "   ON (my.node_id = y.id AND my.version = y.version) ".
237                          " WHERE mx.metadata_type = '$self->{x}' ".
238              "   AND my.metadata_type = '$self->{y}' ".
239              "   AND mx.metadata_value >= " . ($sx - $metres) .
240              "   AND mx.metadata_value <= " . ($sx + $metres) .
241              "   AND my.metadata_value >= " . ($sy - $metres) .
242              "   AND my.metadata_value <= " . ($sy + $metres);
243    $sql .= "     AND x.name != " . $dbh->quote($args{node})
244        if $args{node};
245    # Postgres is a fussy bugger.
246    if ( ref $store eq "Wiki::Toolkit::Store::Pg" ) {
247        $sql =~ s/metadata_value/metadata_value::integer/gs;
248    }
249    # SQLite 3 is even fussier.
250    if ( ref $store eq "Wiki::Toolkit::Store::SQLite"
251         && $DBD::SQLite::VERSION >= "1.00" ) {
252        $sql =~ s/metadata_value/metadata_value+0/gs; # yuck
253    }
254    my $sth = $dbh->prepare($sql);
255    $sth->execute;
256    my @results;
257    while ( my ($result) = $sth->fetchrow_array ) {
258        my $dist = $self->distance( from_x  => $sx,
259                                    from_y  => $sy,
260                                    to_node => $result,
261                                    unit    => "metres" );
262        if ( defined $dist && $dist <= $metres ) {
263            push @results, $result;
264        }
265    }
266    return @results;
267}
268
269=head1 SEE ALSO
270
271=over 4
272
273=item * L<Wiki::Toolkit>
274
275=item * L<OpenGuides> - an application that uses this plugin.
276
277=back
278
279=head1 AUTHOR
280
281Kake Pugh (kake@earth.li).
282The Wiki::Toolkit team (http://www.wiki-toolkit.org/)
283
284=head1 COPYRIGHT
285
286     Copyright (C) 2004 Kake L Pugh.  All Rights Reserved.
287     Copyright (C) 2006 the Wiki::Toolkit Team. All Rights Reserved.
288
289This module is free software; you can redistribute it and/or modify it
290under the same terms as Perl itself.
291
292=head1 CREDITS
293
294This module is based heavily on (and is the replacement for)
295L<Wiki::Toolkit::Plugin::Locator::UK>.
296
297The following thanks are due to people who helped with
298L<Wiki::Toolkit::Plugin::Locator::UK>: Nicholas Clark found a very silly
299bug in a pre-release version, oops :) Stephen White got me thinking in
300the right way to implement C<find_within_distance>. Marcel Gruenauer
301helped me make C<find_within_distance> work properly with postgres.
302
303=cut
304
305
3061;
Note: See TracBrowser for help on using the repository browser.