source: trunk/lib/OpenGuides/Utils.pm @ 933

Last change on this file since 933 was 933, checked in by kake, 15 years ago

Add MAP_LINK and INCLUDE_NODE macros (ticket #100).

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 11.4 KB
Line 
1package OpenGuides::Utils;
2
3use strict;
4use vars qw( $VERSION );
5$VERSION = '0.09';
6
7use Carp qw( croak );
8use Wiki::Toolkit;
9use Wiki::Toolkit::Formatter::UseMod;
10use Wiki::Toolkit::Plugin::RSS::Reader;
11use URI::Escape;
12
13=head1 NAME
14
15OpenGuides::Utils - General utility methods for OpenGuides scripts.
16
17=head1 DESCRIPTION
18
19Provides general utility methods for OpenGuides scripts.  Distributed
20and installed as part of the OpenGuides project, not intended for
21independent installation.  This documentation is probably only useful
22to OpenGuides developers.
23
24=head1 SYNOPSIS
25
26  use OpenGuide::Config;
27  use OpenGuides::Utils;
28
29  my $config = OpenGuides::Config->new( file => "wiki.conf" );
30  my $wiki = OpenGuides::Utils->make_wiki_object( config => $config );
31
32=head1 METHODS
33
34=over 4
35
36=item B<make_wiki_object>
37
38  my $config = OpenGuides::Config->new( file => "wiki.conf" );
39  my $wiki = OpenGuides::Utils->make_wiki_object( config => $config );
40
41Croaks unless an C<OpenGuides::Config> object is supplied.  Returns a
42C<Wiki::Toolkit> object made from the given config file on success,
43croaks if any other error occurs.
44
45The config file needs to define at least the following variables:
46
47=over
48
49=item *
50
51dbtype - one of C<postgres>, C<mysql> and C<sqlite>
52
53=item *
54
55dbname
56
57=item *
58
59indexing_directory - for the L<Search::InvertedIndex> or L<Plucene> files to go
60
61=back
62
63=cut
64
65sub make_wiki_object {
66    my ($class, %args) = @_;
67    my $config = $args{config} or croak "No config param supplied";
68    croak "config param isn't an OpenGuides::Config object"
69        unless UNIVERSAL::isa( $config, "OpenGuides::Config" );
70
71    # Require in the right database module.
72    my $dbtype = $config->dbtype;
73
74    my %cgi_wiki_exts = (
75                          postgres => "Pg",
76                          mysql    => "MySQL",
77                          sqlite   => "SQLite",
78                        );
79
80    my $cgi_wiki_module = "Wiki::Toolkit::Store::" . $cgi_wiki_exts{$dbtype};
81    eval "require $cgi_wiki_module";
82    croak "Can't 'require' $cgi_wiki_module.\n" if $@;
83
84    # Make store.
85    my $store = $cgi_wiki_module->new(
86        dbname  => $config->dbname,
87        dbuser  => $config->dbuser,
88        dbpass  => $config->dbpass,
89        dbhost  => $config->dbhost,
90        charset => $config->dbencoding,
91    );
92
93    # Make search.
94    my $search;
95    if ( $config->use_plucene
96         && ( lc($config->use_plucene) eq "y"
97              || $config->use_plucene == 1 )
98       ) {
99        require Wiki::Toolkit::Search::Plucene;
100        $search = Wiki::Toolkit::Search::Plucene->new(
101                                       path => $config->indexing_directory,
102                                                 );
103    } else {
104        require Wiki::Toolkit::Search::SII;
105        require Search::InvertedIndex::DB::DB_File_SplitHash;
106        my $indexdb = Search::InvertedIndex::DB::DB_File_SplitHash->new(
107            -map_name  => $config->indexing_directory,
108            -lock_mode => "EX"
109        );
110        $search = Wiki::Toolkit::Search::SII->new( indexdb => $indexdb );
111    }
112
113    # Make formatter.
114    my $script_name = $config->script_name;
115    my $search_url = $config->script_url . "search.cgi";
116
117    my %macros = (
118        '@SEARCHBOX' =>
119            qq(<form action="$search_url" method="get"><input type="text" size="20" name="search"><input type="submit" name="Go" value="Search"></form>),
120        qr/\@INDEX_LINK\s+\[\[(Category|Locale)\s+([^\]|]+)\|?([^\]]+)?\]\]/ =>
121            sub {
122                  # We may be being called by Wiki::Toolkit::Plugin::Diff,
123                  # which doesn't know it has to pass us $wiki - and
124                  # we don't use it anyway.
125                  if ( UNIVERSAL::isa( $_[0], "Wiki::Toolkit" ) ) {
126                      shift; # just throw it away
127                  }
128                  my $link_title = $_[2] || "View all pages in $_[0] $_[1]";
129                  return qq(<a href="$script_name?action=index;index_type=) . uri_escape(lc($_[0])) . qq(;index_value=) . uri_escape($_[1]) . qq(">$link_title</a>);
130                },
131        qr/\@INDEX_LIST\s+\[\[(Category|Locale)\s+([^\]]+)]]/ =>
132             sub {
133                   my ($wiki, $type, $value) = @_;
134
135                   # We may be being called by Wiki::Toolkit::Plugin::Diff,
136                   # which doesn't know it has to pass us $wiki
137                   unless ( UNIVERSAL::isa( $wiki, "Wiki::Toolkit" ) ) {
138                       return "(unprocessed INDEX_LIST macro)";
139                   }
140
141                   my @nodes = sort $wiki->list_nodes_by_metadata(
142                       metadata_type  => $type,
143                       metadata_value => $value,
144                       ignore_case    => 1,
145                   );
146                   unless ( scalar @nodes ) {
147                       return "\n* No pages currently in "
148                              . lc($type) . " $value\n";
149                   }
150                   my $return = "\n";
151                   foreach my $node ( @nodes ) {
152                       $return .= "* "
153                               . $wiki->formatter->format_link(
154                                                                wiki => $wiki,
155                                                                link => $node,
156                                                              )
157                                . "\n";
158                   }
159                   return $return;
160                 },
161        qr/\@MAP_LINK\s+\[\[(Category|Locale)\s+([^\]|]+)\|?([^\]]+)?\]\]/ =>
162                sub {
163                      if ( UNIVERSAL::isa( $_[0], "Wiki::Toolkit" ) ) {
164                          shift; # don't need $wiki
165                      }
166                      my $link_title = $_[2]
167                                       || "View map of pages in $_[0] $_[1]";
168                      return qq(<a href="$script_name?action=index;format=map;index_type=) . uri_escape(lc($_[0])) . qq(;index_value=) . uri_escape($_[1]) . qq(">$link_title</a>);
169                },
170        qr/\@INCLUDE_NODE\s+\[\[([^\]|]+)\]\]/ => 
171            sub {
172                  my ($wiki, $node) = @_;
173                  my %node_data = $wiki->retrieve_node( $node );
174                  return $node_data{content};
175                },
176        qr/\@RSS\s+(.+)/ => sub {
177                    # We may be being called by Wiki::Toolkit::Plugin::Diff,
178                    # which doesn't know it has to pass us $wiki - and
179                    # we don't use it anyway.
180                    if ( UNIVERSAL::isa( $_[0], "Wiki::Toolkit" ) ) {
181                        shift; # just throw it away
182                    }
183
184                    my $url = shift;
185
186                    # The URL will already have been processed as an inline
187                    # link, so transform it back again.
188                    if ( $url =~ m/href="([^"]+)/ ) {
189                        $url = $1;
190                    }
191
192                    my $rss = Wiki::Toolkit::Plugin::RSS::Reader->new(url => $url);
193                    my @items = $rss->retrieve;
194
195                    # Ten items only at this till.
196                    $#items = 10 if $#items > 10;
197
198                    # Make a UseMod-formatted list with them - macros are
199                    # processed *before* UseMod formatting is applied but
200                    # *after* inline links like [http://foo/ bar]
201                    my $list = "\n";
202                    foreach (@items) {
203                        my $link        = $_->{link};
204                        my $title       = $_->{title};
205                        my $description = $_->{description};
206                        $list .= qq{* <a href="$link">$title</a>};
207                        $list .= " - $description" if $description;
208                        $list .= "\n";
209                    }
210                    $list .= "</ul>\n";
211        },
212    );
213
214    my $formatter = Wiki::Toolkit::Formatter::UseMod->new(
215        extended_links      => 1,
216        implicit_links      => 0,
217        allowed_tags        => [qw(a p b strong i em pre small img table td
218                                   tr th br hr ul li center blockquote kbd
219                                   div code strike sub sup font)],
220        macros              => \%macros,
221        pass_wiki_to_macros => 1,
222        node_prefix         => "$script_name?",
223        edit_prefix         => "$script_name?action=edit;id=",
224        munge_urls          => 1,
225    );
226
227    my %conf = ( store     => $store,
228                 search    => $search,
229                 formatter => $formatter );
230
231    my $wiki = Wiki::Toolkit->new( %conf );
232    return $wiki;
233}
234
235=item B<get_wgs84_coords>
236
237Returns coordinate data suitable for use with Google Maps (and other GIS
238systems that assume WGS-84 data).
239
240    my ($wgs84_long, $wgs84_lat) = OpenGuides::Utils->get_wgs84_coords(
241                                        longitude => $longitude,
242                                        latitude => $latitude,
243                                        config => $config
244                                   );
245
246=cut
247
248sub get_wgs84_coords {
249    my ($self, %args) = @_;
250    my ($longitude, $latitude, $config) = ($args{longitude}, $args{latitude},
251                                           $args{config})
252       or croak "No longitude supplied to get_wgs84_coords";
253    croak "geo_handler not defined!" unless $config->geo_handler;
254
255    if ($config->force_wgs84) {
256        # Only as a rough approximation, good enough for large scale guides
257        return ($longitude, $latitude);
258    }
259
260    # If we don't have a lat and long, return undef right away
261    unless($args{longitude} || $args{latitude}) {
262        return undef;
263    }
264
265    # Try to load a provider of Helmert Transforms
266    my $helmert;
267    # First up, try the MySociety Geo::HelmertTransform
268    unless($helmert) {
269        eval {
270            require Geo::HelmertTransform;
271            $helmert = sub($$$) {
272                my ($datum,$oldlat,$oldlong) = @_;
273                if ($datum eq 'Airy') {
274                    $datum = 'Airy1830';
275                }
276                my $datum_helper = new Geo::HelmertTransform::Datum(Name=>$datum);
277                my $wgs84_helper = new Geo::HelmertTransform::Datum(Name=>'WGS84');
278                unless($datum_helper) {
279                    croak("No convertion helper for datum '$datum'");
280                    return undef;
281                }
282
283                my ($lat,$long,$h) = 
284                    Geo::HelmertTransform::convert_datum($datum_helper,$wgs84_helper,$oldlat,$oldlong,0);
285                return ($long,$lat);
286            };
287        };
288    }
289    # Next, try .....
290    unless($helmert) {
291        eval {
292        };
293    }
294    # Give up, return undef
295    unless($helmert) {
296       return undef; 
297    }
298   
299
300    if ($config->geo_handler == 1) {
301        # Do conversion here
302        return &$helmert('Airy1830',$latitude,$longitude);
303    } elsif ($config->geo_handler == 2) {
304        # Do conversion here
305        return &$helmert('Airy1830Modified',$latitude,$longitude);
306    } elsif ($config->geo_handler == 3) {
307        if ($config->ellipsoid eq "WGS-84") {
308            return ($longitude, $latitude);
309        } else {
310            # Do conversion here
311            return &$helmert($config->ellipsoid,$latitude,$longitude);
312        }
313    } else {
314        croak "Invalid geo_handler config option $config->geo_handler";
315    }
316}
317
318=back
319
320=head1 AUTHOR
321
322The OpenGuides Project (openguides-dev@lists.openguides.org)
323
324=head1 COPYRIGHT
325
326     Copyright (C) 2003-2005 The OpenGuides Project.  All Rights Reserved.
327
328This module is free software; you can redistribute it and/or modify it
329under the same terms as Perl itself.
330
331=cut
332
3331;
Note: See TracBrowser for help on using the repository browser.