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

Last change on this file since 963 was 963, checked in by Earle Martin, 15 years ago

It's not called CGI::Wiki any more.

  • 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 %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/\@INCLUDE_NODE\s+\[\[([^\]|]+)\]\]/ => 
172            sub {
173                  my ($wiki, $node) = @_;
174                  my %node_data = $wiki->retrieve_node( $node );
175                  return $node_data{content};
176                },
177        qr/\@RSS\s+(.+)/ => sub {
178                    # We may be being called by Wiki::Toolkit::Plugin::Diff,
179                    # which doesn't know it has to pass us $wiki - and
180                    # we don't use it anyway.
181                    if ( UNIVERSAL::isa( $_[0], "Wiki::Toolkit" ) ) {
182                        shift; # just throw it away
183                    }
184
185                    my $url = shift;
186
187                    # The URL will already have been processed as an inline
188                    # link, so transform it back again.
189                    if ( $url =~ m/href="([^"]+)/ ) {
190                        $url = $1;
191                    }
192
193                    my $rss = Wiki::Toolkit::Plugin::RSS::Reader->new(url => $url);
194                    my @items = $rss->retrieve;
195
196                    # Ten items only at this till.
197                    $#items = 10 if $#items > 10;
198
199                    # Make a UseMod-formatted list with them - macros are
200                    # processed *before* UseMod formatting is applied but
201                    # *after* inline links like [http://foo/ bar]
202                    my $list = "\n";
203                    foreach (@items) {
204                        my $link        = $_->{link};
205                        my $title       = $_->{title};
206                        my $description = $_->{description};
207                        $list .= qq{* <a href="$link">$title</a>};
208                        $list .= " - $description" if $description;
209                        $list .= "\n";
210                    }
211                    $list .= "</ul>\n";
212        },
213    );
214
215    my $formatter = Wiki::Toolkit::Formatter::UseMod->new(
216        extended_links      => 1,
217        implicit_links      => 0,
218        allowed_tags        => [qw(a p b strong i em pre small img table td
219                                   tr th br hr ul li center blockquote kbd
220                                   div code strike sub sup font)],
221        macros              => \%macros,
222        pass_wiki_to_macros => 1,
223        node_prefix         => "$script_name?",
224        edit_prefix         => "$script_name?action=edit;id=",
225        munge_urls          => 1,
226    );
227
228    my %conf = ( store     => $store,
229                 search    => $search,
230                 formatter => $formatter );
231
232    my $wiki = Wiki::Toolkit->new( %conf );
233    return $wiki;
234}
235
236=item B<get_wgs84_coords>
237
238Returns coordinate data suitable for use with Google Maps (and other GIS
239systems that assume WGS-84 data).
240
241    my ($wgs84_long, $wgs84_lat) = OpenGuides::Utils->get_wgs84_coords(
242                                        longitude => $longitude,
243                                        latitude => $latitude,
244                                        config => $config
245                                   );
246
247=cut
248
249sub get_wgs84_coords {
250    my ($self, %args) = @_;
251    my ($longitude, $latitude, $config) = ($args{longitude}, $args{latitude},
252                                           $args{config})
253       or croak "No longitude supplied to get_wgs84_coords";
254    croak "geo_handler not defined!" unless $config->geo_handler;
255
256    if ($config->force_wgs84) {
257        # Only as a rough approximation, good enough for large scale guides
258        return ($longitude, $latitude);
259    }
260
261    # If we don't have a lat and long, return undef right away
262    unless($args{longitude} || $args{latitude}) {
263        return undef;
264    }
265
266    # Try to load a provider of Helmert Transforms
267    my $helmert;
268    # First up, try the MySociety Geo::HelmertTransform
269    unless($helmert) {
270        eval {
271            require Geo::HelmertTransform;
272            $helmert = sub($$$) {
273                my ($datum,$oldlat,$oldlong) = @_;
274                if ($datum eq 'Airy') {
275                    $datum = 'Airy1830';
276                }
277                my $datum_helper = new Geo::HelmertTransform::Datum(Name=>$datum);
278                my $wgs84_helper = new Geo::HelmertTransform::Datum(Name=>'WGS84');
279                unless($datum_helper) {
280                    croak("No convertion helper for datum '$datum'");
281                    return undef;
282                }
283
284                my ($lat,$long,$h) = 
285                    Geo::HelmertTransform::convert_datum($datum_helper,$wgs84_helper,$oldlat,$oldlong,0);
286                return ($long,$lat);
287            };
288        };
289    }
290    # Next, try .....
291    unless($helmert) {
292        eval {
293        };
294    }
295    # Give up, return undef
296    unless($helmert) {
297       return undef; 
298    }
299   
300
301    if ($config->geo_handler == 1) {
302        # Do conversion here
303        return &$helmert('Airy1830',$latitude,$longitude);
304    } elsif ($config->geo_handler == 2) {
305        # Do conversion here
306        return &$helmert('Airy1830Modified',$latitude,$longitude);
307    } elsif ($config->geo_handler == 3) {
308        if ($config->ellipsoid eq "WGS-84") {
309            return ($longitude, $latitude);
310        } else {
311            # Do conversion here
312            return &$helmert($config->ellipsoid,$latitude,$longitude);
313        }
314    } else {
315        croak "Invalid geo_handler config option $config->geo_handler";
316    }
317}
318
319=back
320
321=head1 AUTHOR
322
323The OpenGuides Project (openguides-dev@lists.openguides.org)
324
325=head1 COPYRIGHT
326
327     Copyright (C) 2003-2005 The OpenGuides Project.  All Rights Reserved.
328
329This module is free software; you can redistribute it and/or modify it
330under the same terms as Perl itself.
331
332=cut
333
3341;
Note: See TracBrowser for help on using the repository browser.