source: trunk/lib/OpenGuides/UK/PubCrawl.pm @ 785

Last change on this file since 785 was 785, checked in by Dominic Hargreaves, 15 years ago

Use Wiki::Toolkit. Note that CGI::Wiki::Plugin::Diff hasn't been converted yet,
so tests will be broken for now.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 4.9 KB
Line 
1package OpenGuides::UK::PubCrawl;
2use strict;
3
4use vars qw( $VERSION @ISA );
5$VERSION = '0.02';
6
7use Carp qw( croak );
8use Wiki::Toolkit::Plugin;
9use Wiki::Toolkit::Plugin::Locator::UK;
10
11@ISA = qw( Wiki::Toolkit::Plugin );
12
13=head1 NAME
14
15OpenGuides::UK::PubCrawl - An OpenGuides plugin to generate pub crawls.
16
17=head1 DESCRIPTION
18
19Generates pub crawls for OpenGuides installations based in the United
20Kingdom.  Distributed and installed as part of the OpenGuides project,
21not intended for independent installation.  This documentation is
22probably only useful to OpenGuides developers.
23
24=head1 SYNOPSIS
25
26  use Wiki::Toolkit;
27  use Wiki::Toolkit::Plugin::Locator::UK;
28  use OpenGuides::UK::PubCrawl;
29
30  my $wiki = Wiki::Toolkit->new( ... );
31  my $locator = Wiki::Toolkit::Plugin::Locator::UK->new;
32  $wiki->register_plugin( plugin => $locator );
33  my $categoriser = Wiki::Toolkit::Plugin::Categoriser->new;
34  $wiki->register_plugin( plugin => $categoriser );
35
36  my $crawler = OpenGuides::UK::PubCrawl->new(
37      locator     => $locator,
38      categoriser => $categoriser );
39  $wiki->register_plugin( plugin => $crawler );
40 
41=head1 METHODS
42
43=over 4
44
45=item B<new>
46
47  my $crawler = OpenGuides::UK::PubCrawl->new(
48      locator     => $locator,
49      categoriser => $categoriser );
50
51  my $crawler = OpenGuides::UK::PubCrawl->new( locator => $locator );
52
53Croaks unless a C<Wiki::Toolkit::Plugin::Locator::UK> object and a
54C<Wiki::Toolkit::Plugin::Categoriser> object are supplied.
55
56=cut
57
58sub new {
59    my ($class, %args) = @_;
60    my $locator = $args{locator}
61      or croak "No locator parameter supplied";
62    croak "Locator parameter is not a Wiki::Toolkit::Plugin::Locator::UK"
63      unless UNIVERSAL::isa( $locator, "Wiki::Toolkit::Plugin::Locator::UK" );
64    my $categoriser = $args{categoriser}
65      or croak "No categoriser parameter supplied";
66    croak "Categoriser parameter is not a Wiki::Toolkit::Plugin::Categoriser"
67      unless UNIVERSAL::isa( $categoriser, "Wiki::Toolkit::Plugin::Categoriser" );
68    my $self = { _locator     => $locator,
69                 _categoriser => $categoriser };
70    bless $self, $class;
71    return $self;
72}
73
74=item B<locator>
75
76Returns locator object.
77
78=cut
79
80sub locator {
81    my $self = shift;
82    return $self->{_locator};
83}
84
85=item B<categoriser>
86
87Returns categoriser object.
88
89=cut
90
91sub categoriser {
92    my $self = shift;
93    return $self->{_categoriser};
94}
95
96=item B<generate_crawl>
97
98  my @crawl = $crawler->generate_crawl( start_location =>
99                                            { os_x => 528385,
100                                              os_y => 180605  },
101                                        max_km_between => 0.5,
102                                        num_pubs => 5,
103                                        omit => "Ivy House"
104                                      );
105
106These are the only options so far.  Returns an array of nodenames.
107C<num_pubs> will default to 5, for the sake of your liver.  If it
108can't find a crawl as long as you asked for, returns the longest one
109it could find.
110
111=cut
112
113sub generate_crawl {
114    my ($self, %args) = @_;
115    my $x = $args{start_location}{os_x} or croak "No os_x";
116    my $y = $args{start_location}{os_y} or croak "No os_y";
117    my $km = $args{max_km_between} or croak "No max_km_between";
118    my $num_pubs = $args{num_pubs} || 5;
119    my $locator = $self->locator;
120    my $categoriser = $self->categoriser;
121    my @firsts = $locator->find_within_distance( os_x       => $x,
122                                                 os_y       => $y,
123                                                 kilometres => $km );
124    my %omit = map { $_ => 1 } @{ $args{omit} || [] };
125    @firsts = grep { !$omit{$_}
126                     and $categoriser->in_category( category => "Pubs",
127                                                    node     => $_      )
128                   } @firsts;
129    return () unless scalar @firsts;
130
131    # If we're only after one pub (bottom of recursion) return one now.
132    return $firsts[0] if $num_pubs == 1;
133
134    # Be prepared to save the longest crawl found, in case we can't find
135    # one as long as requested.
136    my @fallback = ();
137
138    foreach my $first ( @firsts ) {
139        my @coords = $locator->coordinates( node => $first );
140        my @tail = $self->generate_crawl(
141            start_location => { os_x => $coords[0],
142                                os_y => $coords[1] },
143            max_km_between => $km,
144            omit => [ $first, keys %omit ],
145            num_pubs => $num_pubs - 1
146        );
147        if ( scalar @tail and scalar @tail == ( $num_pubs - 1 ) ) {
148            return ( $first, @tail );
149        } elsif ( scalar @tail + 1 > scalar @fallback ) {
150            @fallback = ( $first, @tail );
151        }
152    }
153    return @fallback;
154}
155
156=back
157
158=head1 AUTHOR
159
160The OpenGuides Project (openguides-dev@openguides.org)
161
162=head1 COPYRIGHT
163
164     Copyright (C) 2003 The OpenGuides Project.  All Rights Reserved.
165
166This module is free software; you can redistribute it and/or modify it
167under the same terms as Perl itself.
168
169=cut
170
1711;
Note: See TracBrowser for help on using the repository browser.