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

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

Added category and locale parameters to action=random and made a new macro to go with it.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 12.3 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 %wiki_toolkit_exts = (
75                          postgres => "Pg",
76                          mysql    => "MySQL",
77                          sqlite   => "SQLite",
78                        );
79
80    my $wiki_toolkit_module = "Wiki::Toolkit::Store::" . $wiki_toolkit_exts{$dbtype};
81    eval "require $wiki_toolkit_module";
82    croak "Can't 'require' $wiki_toolkit_module.\n" if $@;
83
84    # Make store.
85    my $store = $wiki_toolkit_module->new(
86        dbname  => $config->dbname,
87        dbuser  => $config->dbuser,
88        dbpass  => $config->dbpass,
89        dbhost  => $config->dbhost,
90        dbport  => $config->dbport,
91        charset => $config->dbencoding,
92    );
93
94    # Make search.
95    my $search;
96    if ( $config->use_plucene
97         && ( lc($config->use_plucene) eq "y"
98              || $config->use_plucene == 1 )
99       ) {
100        require Wiki::Toolkit::Search::Plucene;
101        $search = Wiki::Toolkit::Search::Plucene->new(
102                                       path => $config->indexing_directory,
103                                                 );
104    } else {
105        require Wiki::Toolkit::Search::SII;
106        require Search::InvertedIndex::DB::DB_File_SplitHash;
107        my $indexdb = Search::InvertedIndex::DB::DB_File_SplitHash->new(
108            -map_name  => $config->indexing_directory,
109            -lock_mode => "EX"
110        );
111        $search = Wiki::Toolkit::Search::SII->new( indexdb => $indexdb );
112    }
113
114    # Make formatter.
115    my $script_name = $config->script_name;
116    my $search_url = $config->script_url . "search.cgi";
117
118    my %macros = (
119        '@SEARCHBOX' =>
120            qq(<form action="$search_url" method="get"><input type="text" size="20" name="search"><input type="submit" name="Go" value="Search"></form>),
121        qr/\@INDEX_LINK\s+\[\[(Category|Locale)\s+([^\]|]+)\|?([^\]]+)?\]\]/ =>
122            sub {
123                  # We may be being called by Wiki::Toolkit::Plugin::Diff,
124                  # which doesn't know it has to pass us $wiki - and
125                  # we don't use it anyway.
126                  if ( UNIVERSAL::isa( $_[0], "Wiki::Toolkit" ) ) {
127                      shift; # just throw it away
128                  }
129                  my $link_title = $_[2] || "View all pages in $_[0] $_[1]";
130                  return qq(<a href="$script_name?action=index;index_type=) . uri_escape(lc($_[0])) . qq(;index_value=) . uri_escape($_[1]) . qq(">$link_title</a>);
131                },
132        qr/\@INDEX_LIST\s+\[\[(Category|Locale)\s+([^\]]+)]]/ =>
133             sub {
134                   my ($wiki, $type, $value) = @_;
135
136                   # We may be being called by Wiki::Toolkit::Plugin::Diff,
137                   # which doesn't know it has to pass us $wiki
138                   unless ( UNIVERSAL::isa( $wiki, "Wiki::Toolkit" ) ) {
139                       return "(unprocessed INDEX_LIST macro)";
140                   }
141
142                   my @nodes = sort $wiki->list_nodes_by_metadata(
143                       metadata_type  => $type,
144                       metadata_value => $value,
145                       ignore_case    => 1,
146                   );
147                   unless ( scalar @nodes ) {
148                       return "\n* No pages currently in "
149                              . lc($type) . " $value\n";
150                   }
151                   my $return = "\n";
152                   foreach my $node ( @nodes ) {
153                       $return .= "* "
154                               . $wiki->formatter->format_link(
155                                                                wiki => $wiki,
156                                                                link => $node,
157                                                              )
158                                . "\n";
159                   }
160                   return $return;
161                 },
162        qr/\@MAP_LINK\s+\[\[(Category|Locale)\s+([^\]|]+)\|?([^\]]+)?\]\]/ =>
163                sub {
164                      if ( UNIVERSAL::isa( $_[0], "Wiki::Toolkit" ) ) {
165                          shift; # don't need $wiki
166                      }
167                      my $link_title = $_[2]
168                                       || "View map of pages in $_[0] $_[1]";
169                      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>);
170                },
171        qr/\@RANDOM_PAGE_LINK(?:\s+\[\[(Category|Locale)\s+([^\]|]+)\|?([^\]]+)?\]\])?/ =>
172                sub {
173                      if ( UNIVERSAL::isa( $_[0], "Wiki::Toolkit" ) ) {
174                          shift; # don't need $wiki
175                      }
176                      my ( $type, $value, $link_title ) = @_;
177                      my $link = "$script_name?action=random";
178
179                      if ( $type && $value ) {
180                          $link .= ";" . lc( uri_escape( $type ) ) . "="
181                                . lc( uri_escape( $value ) );
182                          $link_title ||= "View a random page in $type $value";
183                      } else {
184                          $link_title ||= "View a random page on this guide";
185                      }
186                      return qq(<a href="$link">$link_title</a>);
187                },
188        qr/\@INCLUDE_NODE\s+\[\[([^\]|]+)\]\]/ => 
189            sub {
190                  my ($wiki, $node) = @_;
191                  my %node_data = $wiki->retrieve_node( $node );
192                  return $node_data{content};
193                },
194        qr/\@RSS\s+(.+)/ => sub {
195                    # We may be being called by Wiki::Toolkit::Plugin::Diff,
196                    # which doesn't know it has to pass us $wiki - and
197                    # we don't use it anyway.
198                    if ( UNIVERSAL::isa( $_[0], "Wiki::Toolkit" ) ) {
199                        shift; # just throw it away
200                    }
201
202                    my $url = shift;
203
204                    # The URL will already have been processed as an inline
205                    # link, so transform it back again.
206                    if ( $url =~ m/href="([^"]+)/ ) {
207                        $url = $1;
208                    }
209
210                    my $rss = Wiki::Toolkit::Plugin::RSS::Reader->new(url => $url);
211                    my @items = $rss->retrieve;
212
213                    # Ten items only at this till.
214                    $#items = 10 if $#items > 10;
215
216                    # Make a UseMod-formatted list with them - macros are
217                    # processed *before* UseMod formatting is applied but
218                    # *after* inline links like [http://foo/ bar]
219                    my $list = "\n";
220                    foreach (@items) {
221                        my $link        = $_->{link};
222                        my $title       = $_->{title};
223                        my $description = $_->{description};
224                        $list .= qq{* <a href="$link">$title</a>};
225                        $list .= " - $description" if $description;
226                        $list .= "\n";
227                    }
228                    $list .= "</ul>\n";
229        },
230    );
231
232    my $formatter = Wiki::Toolkit::Formatter::UseMod->new(
233        extended_links      => 1,
234        implicit_links      => 0,
235        allowed_tags        => [qw(a p b strong i em pre small img table td
236                                   tr th br hr ul li center blockquote kbd
237                                   div code strike sub sup font)],
238        macros              => \%macros,
239        pass_wiki_to_macros => 1,
240        node_prefix         => "$script_name?",
241        edit_prefix         => "$script_name?action=edit;id=",
242        munge_urls          => 1,
243    );
244
245    my %conf = ( store     => $store,
246                 search    => $search,
247                 formatter => $formatter );
248
249    my $wiki = Wiki::Toolkit->new( %conf );
250    return $wiki;
251}
252
253=item B<get_wgs84_coords>
254
255Returns coordinate data suitable for use with Google Maps (and other GIS
256systems that assume WGS-84 data).
257
258    my ($wgs84_long, $wgs84_lat) = OpenGuides::Utils->get_wgs84_coords(
259                                        longitude => $longitude,
260                                        latitude => $latitude,
261                                        config => $config
262                                   );
263
264=cut
265
266sub get_wgs84_coords {
267    my ($self, %args) = @_;
268    my ($longitude, $latitude, $config) = ($args{longitude}, $args{latitude},
269                                           $args{config})
270       or croak "No longitude supplied to get_wgs84_coords";
271    croak "geo_handler not defined!" unless $config->geo_handler;
272
273    if ($config->force_wgs84) {
274        # Only as a rough approximation, good enough for large scale guides
275        return ($longitude, $latitude);
276    }
277
278    # If we don't have a lat and long, return undef right away
279    unless($args{longitude} || $args{latitude}) {
280        return undef;
281    }
282
283    # Try to load a provider of Helmert Transforms
284    my $helmert;
285    # First up, try the MySociety Geo::HelmertTransform
286    unless($helmert) {
287        eval {
288            require Geo::HelmertTransform;
289            $helmert = sub($$$) {
290                my ($datum,$oldlat,$oldlong) = @_;
291                if ($datum eq 'Airy') {
292                    $datum = 'Airy1830';
293                }
294                my $datum_helper = new Geo::HelmertTransform::Datum(Name=>$datum);
295                my $wgs84_helper = new Geo::HelmertTransform::Datum(Name=>'WGS84');
296                unless($datum_helper) {
297                    croak("No convertion helper for datum '$datum'");
298                    return undef;
299                }
300
301                my ($lat,$long,$h) = 
302                    Geo::HelmertTransform::convert_datum($datum_helper,$wgs84_helper,$oldlat,$oldlong,0);
303                return ($long,$lat);
304            };
305        };
306    }
307    # Next, try .....
308    unless($helmert) {
309        eval {
310        };
311    }
312    # Give up, return undef
313    unless($helmert) {
314       return undef; 
315    }
316   
317
318    if ($config->geo_handler == 1) {
319        # Do conversion here
320        return &$helmert('Airy1830',$latitude,$longitude);
321    } elsif ($config->geo_handler == 2) {
322        # Do conversion here
323        return &$helmert('Airy1830Modified',$latitude,$longitude);
324    } elsif ($config->geo_handler == 3) {
325        if ($config->ellipsoid eq "WGS-84") {
326            return ($longitude, $latitude);
327        } else {
328            # Do conversion here
329            return &$helmert($config->ellipsoid,$latitude,$longitude);
330        }
331    } else {
332        croak "Invalid geo_handler config option $config->geo_handler";
333    }
334}
335
336=back
337
338=head1 AUTHOR
339
340The OpenGuides Project (openguides-dev@lists.openguides.org)
341
342=head1 COPYRIGHT
343
344     Copyright (C) 2003-2007 The OpenGuides Project.  All Rights Reserved.
345
346This module is free software; you can redistribute it and/or modify it
347under the same terms as Perl itself.
348
349=cut
350
3511;
Note: See TracBrowser for help on using the repository browser.