source: trunk/lib/OpenGuides/Template.pm @ 1235

Last change on this file since 1235 was 1235, checked in by Dominic Hargreaves, 13 years ago

Display geodata ellipsoid to user in edit from (fixes #230)

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 22.4 KB
Line 
1package OpenGuides::Template;
2
3use strict;
4use vars qw( $VERSION );
5$VERSION = '0.13';
6
7use Carp qw( croak );
8use CGI; # want to get rid of this and put the burden on the templates
9use Geography::NationalGrid;
10use Geography::NationalGrid::GB;
11use OpenGuides; # for $VERSION for template variable
12use OpenGuides::CGI;
13use Template;
14use URI::Escape;
15use Data::Validate::URI qw( is_web_uri );
16
17=head1 NAME
18
19OpenGuides::Template - Do Template Toolkit related stuff for OpenGuides applications.
20
21=head1 DESCRIPTION
22
23Does all the Template Toolkit stuff for OpenGuides.  Distributed and
24installed as part of the OpenGuides project, not intended for
25independent installation.  This documentation is probably only useful
26to OpenGuides developers.
27
28=head1 SYNOPSIS
29
30  use OpenGuides::Config;
31  use OpenGuides::Utils;
32  use OpenGuides::Template;
33
34  my $config = OpenGuides::Config->new( file => "wiki.conf" );
35  my $wiki = OpenGuides::Utils->make_wiki_object( config => $config );
36
37  print OpenGuides::Template->output( wiki     => $wiki,
38                                      config   => $config,
39                                      template => "node.tt",
40                                      vars     => { foo => "bar" }
41  );
42
43=head1 METHODS
44
45=over 4
46
47=item B<output>
48
49  print OpenGuides::Template->output( wiki         => $wiki,
50                                      config       => $config,
51                                      template     => "node.tt",
52                                      content_type => "text/html",
53                                      cookies      => $cookie,
54                                      vars         => {foo => "bar"},
55                                      noheaders    => 1
56  );
57
58Returns everything you need to send to STDOUT, including the
59Content-Type: header. Croaks unless C<template> is supplied.
60
61The config object and variables supplied in C<vars> are passed through
62to the template specified.  Additional Template Toolkit variables are
63automatically set and passed through as well, as described below.
64B<Note:> variables set in C<vars> will over-ride any variables of the
65same name in the config object or the user cookies.
66
67=over
68
69=item * C<openguides_version>
70
71=item * C<site_name>
72
73=item * C<cgi_url>
74
75=item * C<full_cgi_url>
76
77=item * C<enable_page_deletion> (gets set to true or false - defaults to false)
78
79=item * C<contact_email>
80
81=item * C<stylesheet>
82
83=item * C<home_link>
84
85=item * C<formatting_rules_link> (unless C<omit_formatting_link> is set in user cookie)
86
87=item * C<navbar_on_home_page>
88
89=item * C<home_name>
90
91=item * C<gmaps_api_key>
92
93=item * C<licence_name>
94
95=item * C<licence_url>
96
97=item * C<licence_info_url>
98
99=item * C<prefs> (the preferences from the user cookie)
100
101=back
102
103=over
104
105If C<node> is supplied:
106
107=item * C<node_name>
108
109=item * C<node_param> (the node name escaped for use in URLs)
110
111=back
112
113Content-Type: defaults to C<text/html> and is omitted if the
114C<content_type> arg is explicitly set to the blank string.
115
116However, what you more often need is the C<noheaders> option,
117which suppresses all HTTP headers, not just the Content-Type.
118
119The HTTP response code may be explictly set with the C<http_status> arg.
120
121=cut
122
123sub output {
124    my ($class, %args) = @_;
125    croak "No template supplied" unless $args{template};
126    my $config = $args{config} or croak "No config supplied";
127    my $template_path = $config->template_path;
128    my $custom_template_path = $config->custom_template_path || "";
129    my $tt = Template->new( { INCLUDE_PATH => "$custom_template_path:$template_path" } );
130
131    my $script_name  = $config->script_name;
132    my $script_url   = $config->script_url;
133    my $default_city = $config->default_city;
134   
135    # Check cookie to see if we need to set the formatting_rules_link.
136    my ($formatting_rules_link, $omit_help_links);
137    my $formatting_rules_node = $config->formatting_rules_node;
138    $formatting_rules_link = $config->formatting_rules_link;
139    my %cookie_data = OpenGuides::CGI->get_prefs_from_cookie(config=>$config,
140                                                             cookies => $args{cookies},
141                                                            );
142    if ( $cookie_data{omit_help_links} ) {
143        $omit_help_links = 1;
144    } else {
145        if (( $formatting_rules_node ) and !( $formatting_rules_link )){
146            $formatting_rules_link = $script_url . $script_name . "?"
147                                   . uri_escape($args{wiki}->formatter->node_name_to_node_param($formatting_rules_node));
148        }
149    }
150
151    my $enable_page_deletion = 0;
152    if ( $config->enable_page_deletion
153         and ( lc($config->enable_page_deletion) eq "y"
154               or $config->enable_page_deletion eq "1" )
155       ) {
156        $enable_page_deletion = 1;
157    }
158
159    my $tt_vars = {
160        config                => $config,
161        prefs                 => \%cookie_data,
162        site_name             => $config->site_name,
163        cgi_url               => $script_name,
164        script_url            => $script_url,
165        full_cgi_url          => $script_url . $script_name,
166        contact_email         => $config->contact_email,
167        stylesheet            => $config->stylesheet_url,
168        home_link             => $script_url . $script_name,
169        home_name             => $config->home_name,
170        navbar_on_home_page   => $config->navbar_on_home_page,
171        omit_help_links       => $omit_help_links,
172        formatting_rules_link => $formatting_rules_link,
173        formatting_rules_node => $formatting_rules_node,
174        openguides_version    => $OpenGuides::VERSION,
175        enable_page_deletion  => $enable_page_deletion,
176        language              => $config->default_language,
177        http_charset          => $config->http_charset,
178        default_city          => $default_city,
179        gmaps_api_key         => $config->gmaps_api_key,
180        licence_name          => $config->licence_name,
181        licence_url           => $config->licence_url,
182        licence_info_url      => $config->licence_info_url
183    };
184
185    if ($args{node}) {
186        $tt_vars->{node_name} = CGI->escapeHTML($args{node});
187        $tt_vars->{node_param} = CGI->escape($args{wiki}->formatter->node_name_to_node_param($args{node}));
188    }
189
190    # Now set further TT variables if explicitly supplied - do this last
191    # as these override auto-set ones.
192    $tt_vars = { %$tt_vars, %{ $args{vars} || {} } };
193
194    my $header = "";
195
196    unless ( $args{noheaders} ) {
197        my %cgi_header_args;
198
199        if ( defined $args{content_type} and $args{content_type} eq "" ) {
200            $cgi_header_args{'-type'} = '';
201        } else {
202            if ( $args{content_type} ) {
203                $cgi_header_args{'-type'} = $args{content_type};
204            } else {
205                $cgi_header_args{'-type'} = "text/html";
206            }
207        }
208
209        if ( $tt_vars->{http_charset} ) {
210            $cgi_header_args{'-type'} .= "; charset=".$tt_vars->{http_charset};
211        }
212        $cgi_header_args{'-cookie'} = $args{cookies};
213
214        if ( $args{http_status} ) {
215            $cgi_header_args{'-status'} = $args{http_status};
216        }
217
218        $header = CGI::header( %cgi_header_args );
219    }
220
221    # vile hack
222    my %field_vars = OpenGuides::Template->extract_metadata_vars(
223                         wiki                 => $args{wiki},
224                         config               => $config,
225                         set_coord_field_vars => 1,
226                         metadata => {},
227                     );
228
229    $tt_vars = { %field_vars, %$tt_vars };
230
231    my $output;
232    $tt->process( $args{template}, $tt_vars, \$output );
233
234    my $contact_email = $config->contact_email;
235   
236    $output ||= qq(<html><head><title>ERROR</title></head><body><p>
237    Sorry!  Something went wrong.  Please contact the site administrator
238    at <a href="mailto:$contact_email">$contact_email</a> and quote the
239    following error message:</p><blockquote>Failed to process template: )
240        . $tt->error
241        . qq(</blockquote></body></html>);
242
243    return $header . $output;
244}
245
246=item B<extract_metadata_vars>
247
248  my %node_data = $wiki->retrieve_node( "Home Page" );
249
250  my %metadata_vars = OpenGuides::Template->extract_metadata_vars(
251                          wiki     => $wiki,
252                          config   => $config,
253                          metadata => $node_data{metadata}
254                      );
255
256  # -- or --
257
258  my %metadata_vars = OpenGuides::Template->extract_metadata_vars(
259                          wiki     => $wiki,
260                          config   => $config,
261                          cgi_obj  => $q
262                      );
263
264  # -- then --
265
266  print OpenGuides::Template->output(
267            wiki     => $wiki,
268            config   => $config,
269            template => "node.tt",
270            vars     => { foo => "bar",
271                          %metadata_vars }
272        );
273
274Picks out things like categories, locales, phone number etc from
275EITHER the metadata hash returned by L<Wiki::Toolkit> OR the query
276parameters in a L<CGI> object, and packages them nicely for passing to
277templates or storing in L<Wiki::Toolkit> datastore.  If you supply both
278C<metadata> and C<cgi_obj> then C<metadata> will take precedence, but
279don't do that.
280
281The variables C<dist_field>, C<coord_field_1>, C<coord_field_1_name>,
282C<coord_field_1_value>, C<coord_field_2>, C<coord_field_2_name>, and
283C<coord_field_2_value>, which are used to create various forms, will
284only be set if I<either> C<metadata> is supplied I<or>
285C<set_coord_field_vars> is true, to prevent these values from being
286stored in the database on a node commit.
287
288=cut
289
290sub extract_metadata_vars {
291    my ($class, %args) = @_;
292    my %metadata = %{$args{metadata} || {} };
293    my $q = $args{cgi_obj};
294    my $wiki = $args{wiki};
295    my $formatter = $wiki->formatter;
296    my $config = $args{config};
297    my $script_name = $config->script_name;
298
299    # Categories and locales are displayed as links in the page footer.
300    # We return these twice, as eg 'category' being a simple array of
301    # category names, but 'categories' being an array of hashrefs including
302    # a URL too.  This is ick.
303    my (@catlist, @loclist);
304    if ( $args{metadata} ) {
305        @catlist = @{ $metadata{category} || [] };
306        @loclist = @{ $metadata{locale}   || [] };
307    } else {
308        my $categories_text = $q->param('categories');
309        my $locales_text    = $q->param('locales');
310
311        # Basic sanity-checking. Probably lives elsewhere.
312        $categories_text =~ s/</&lt;/g;
313        $categories_text =~ s/>/&gt;/g;
314        $locales_text =~ s/</&lt;/g;
315        $locales_text =~ s/>/&gt;/g;
316
317        @catlist = sort grep { s/^\s+//; s/\s+$//; $_; } # trim lead/trail space
318                        split("\r\n", $categories_text);
319        @loclist = sort grep { s/^\s+//; s/\s+$//; $_; } # trim lead/trail space
320                        split("\r\n", $locales_text);
321    }
322
323    # Some stuff here is copied from OpenGuides->_autoCreateCategoryLocale
324    # - we should rationalise this.
325    my @categories = map {
326        my $param = $formatter->node_name_to_node_param( $_ );
327        my $name = $_;
328        $name =~ s/(.*)/\u$1/;
329        $name = $wiki->formatter->_do_freeupper( "Category $name" );
330        {
331          name => $_,
332          url  => $wiki->node_exists( $name )
333                      ? "$script_name?Category_" . uri_escape( $param )
334                      : "",
335        };
336    } @catlist;
337
338    my @locales = map {
339        my $param = $formatter->node_name_to_node_param( $_ );
340        my $name = $_;
341        $name =~ s/(.*)/\u$1/;
342        $name = $wiki->formatter->_do_freeupper( "Locale $name" );
343        {
344          name => $_,
345          url  => $wiki->node_exists( $name )
346                      ? "$script_name?Locale_" . uri_escape( $param )
347                      : "",
348        };
349    } @loclist;
350
351    my $website = $args{metadata} ? $metadata{website}[0]
352                                  : $q->param("website");
353    my $formatted_website_text = "";
354    if ( $website && $website ne "http://" && is_web_uri( $website ) ) {
355        my $trunc_website = substr( $website, 0, $config->website_link_max_chars );
356        unless ($website eq $trunc_website ) {
357            $trunc_website .= '...';
358        }
359        $formatted_website_text = '<a href="' . $website . '">' . $trunc_website . '</a>';
360    }
361
362    my $hours_text = $args{metadata} ? $metadata{opening_hours_text}[0]
363                                    : $q->param("hours_text");
364
365    my $summary = $args{metadata} ? $metadata{summary}[0]
366                                  : $q->param("summary");
367                                 
368    my %vars = (
369        categories             => \@categories,
370        locales                => \@locales,
371        category               => \@catlist,
372        locale                 => \@loclist,
373        formatted_website_text => $formatted_website_text,
374        hours_text             => $hours_text,
375        summary                => $summary,
376    );
377
378    if ($config->enable_node_image ) {
379        foreach my $key ( qw( node_image node_image_licence node_image_url
380                              node_image_copyright ) ) {
381            my $value = $args{metadata} ? $metadata{$key}[0]
382                                        : $q->param( $key );
383            if ( $value ) {
384                $value =~ s/^\s+//g;
385                $value =~ s/\s+$//g;
386            }
387            $vars{$key} = $value if $value;
388        }
389    }
390
391    if (exists $metadata{source}) {
392        ($vars{source_site}) = $metadata{source}[0] =~ /^(.*?)(?:\?|$)/;
393    }
394   
395    if ( $args{metadata} ) {
396        foreach my $var ( qw( phone fax address postcode os_x os_y osie_x
397                              osie_y latitude longitude map_link website
398                              summary) ) {
399            $vars{$var} = $metadata{$var}[0];
400        }
401        # Data for the distance search forms on the node display.
402        my $geo_handler = $config->geo_handler;
403        if ( $geo_handler == 1 ) {
404            %vars = (
405                        %vars,
406                        coord_field_1       => "os_x",
407                        coord_field_2       => "os_y",
408                        dist_field          => "os_dist",
409                        coord_field_1_name  => "OS X coordinate",
410                        coord_field_2_name  => "OS Y coordinate",
411                        coord_field_1_value => $metadata{os_x}[0],
412                        coord_field_2_value => $metadata{os_y}[0],
413                    );
414        } elsif ( $geo_handler == 2 ) {
415            %vars = (
416                        %vars,
417                        coord_field_1       => "osie_x",
418                        coord_field_2       => "osie_y",
419                        dist_field          => "osie_dist",
420                        coord_field_1_name  =>"Irish National Grid X coordinate",
421                        coord_field_2_name  =>"Irish National Grid Y coordinate",
422                        coord_field_1_value => $metadata{osie_x}[0],
423                        coord_field_2_value => $metadata{osie_y}[0],
424                    );
425        } else {
426            my $lat_text = "Latitude (" . $config->ellipsoid . " decimal)";
427            my $long_text = "Longitude (" . $config->ellipsoid . " decimal)";
428            %vars = (
429                        %vars,
430                        coord_field_1       => "latitude",
431                        coord_field_2       => "longitude",
432                        dist_field          => "latlong_dist",
433                        coord_field_1_name  => $lat_text,
434                        coord_field_2_name  => $long_text,
435                        coord_field_1_value => $metadata{latitude}[0],
436                        coord_field_2_value => $metadata{longitude}[0],
437                    );
438        }
439    } else {
440        foreach my $var ( qw( phone fax address postcode map_link website summary) ) {
441            $vars{$var} = $q->param($var);
442        }
443
444        my $geo_handler = $config->geo_handler;
445        if ( $geo_handler == 1 ) {
446            require Geography::NationalGrid::GB;
447            my $os_x   = $q->param("os_x");
448            my $os_y   = $q->param("os_y");
449            my $lat    = $q->param("latitude");
450            my $long   = $q->param("longitude");
451
452            # Trim whitespace - trailing whitespace buggers up the
453            # integerification by postgres and it's an easy mistake to
454            # make when typing into a form.
455            $os_x =~ s/\s+//g;
456            $os_y =~ s/\s+//g;
457
458            # If we were sent x and y, work out lat/long; and vice versa.
459            if ( defined $os_x && length $os_x && defined $os_y && length $os_y ) {
460                my $point = Geography::NationalGrid::GB->new( Easting =>$os_x,
461                                     Northing=>$os_y);
462                $lat  = sprintf("%.6f", $point->latitude);
463                $long = sprintf("%.6f", $point->longitude);
464            } elsif ( defined $lat && length $lat && defined $long && length $long ) {
465                my $point = Geography::NationalGrid::GB->new(Latitude  => $lat,
466                                                             Longitude => $long);
467                $os_x = $point->easting;
468                $os_y = $point->northing;
469            }
470           
471            if ( defined $os_x && length $os_x && defined $os_y && length $os_y ) {
472                %vars = (
473                            %vars,
474                            latitude  => $lat,
475                            longitude => $long,
476                            os_x      => $os_x,
477                            os_y      => $os_y,
478                        );
479            }
480            if ( $args{set_coord_field_vars} ) {
481                %vars = (
482                            %vars,
483                            coord_field_1       => "os_x",
484                            coord_field_2       => "os_y",
485                            dist_field          => "os_dist",
486                            coord_field_1_name  => "OS X coordinate",
487                            coord_field_2_name  => "OS Y coordinate",
488                            coord_field_1_value => $os_x,
489                            coord_field_2_value => $os_y,
490                        );
491            }
492        } elsif ( $geo_handler == 2 ) {
493            require Geography::NationalGrid::IE;
494            my $osie_x = $q->param("osie_x");
495            my $osie_y = $q->param("osie_y");
496            my $lat    = $q->param("latitude");
497            my $long   = $q->param("longitude");
498
499            # Trim whitespace.
500            $osie_x =~ s/\s+//g;
501            $osie_y =~ s/\s+//g;
502
503            # If we were sent x and y, work out lat/long; and vice versa.
504            if ( defined $osie_x && length $osie_x && defined $osie_y && length $osie_y ) {
505                my $point = Geography::NationalGrid::IE->new(Easting=>$osie_x,
506                                   Northing=>$osie_y);
507                $lat = sprintf("%.6f", $point->latitude);
508                $long = sprintf("%.6f", $point->longitude);
509            } elsif ( defined $lat && length $lat && defined $long && length $long ) {
510                my $point = Geography::NationalGrid::GB->new(Latitude  => $lat,
511                                                             Longitude => $long);
512                $osie_x = $point->easting;
513                $osie_y = $point->northing;
514            }
515            if ( defined $osie_x && length $osie_x && defined $osie_y && length $osie_y ) {
516                %vars = (
517                            %vars,
518                            latitude  => $lat,
519                            longitude => $long,
520                            osie_x    => $osie_x,
521                            osie_y    => $osie_y,
522                        );
523            }
524            if ( $args{set_coord_field_vars} ) {
525                %vars = (
526                            %vars,
527                            coord_field_1       => "osie_x",
528                            coord_field_2       => "osie_y",
529                            dist_field          => "osie_dist",
530                            coord_field_1_name  => "Irish National Grid X coordinate",
531                            coord_field_2_name  => "Irish National Grid Y coordinate",
532                            coord_field_1_value => $osie_x,
533                            coord_field_2_value => $osie_y,
534                        );
535            }
536        } elsif ( $geo_handler == 3 ) {
537            require Geo::Coordinates::UTM;
538            my $lat    = $q->param("latitude");
539            my $long   = $q->param("longitude");
540           
541            if ( defined $lat && length $lat && defined $long && length $long ) {
542                # Trim whitespace.
543                $lat =~ s/\s+//g;
544                $long =~ s/\s+//g;
545                my ($zone, $easting, $northing) =
546                 Geo::Coordinates::UTM::latlon_to_utm( $config->ellipsoid,
547                                                       $lat, $long );
548                $easting  =~ s/\..*//; # chop off decimal places
549                $northing =~ s/\..*//; # - metre accuracy enough
550                %vars = (
551                            %vars,
552                            latitude  => $lat,
553                            longitude => $long,
554                            easting   => $easting,
555                            northing  => $northing,
556                        );
557             }
558             if ( $args{set_coord_field_vars} ) {
559                %vars = (
560                            %vars,
561                            coord_field_1       => "latitude",
562                            coord_field_2       => "longitude",
563                            dist_field          => "latlong_dist",
564                            coord_field_1_name  => "Latitude (decimal)",
565                            coord_field_2_name  => "Longitude (decimal)",
566                            coord_field_1_value => $lat,
567                            coord_field_2_value => $long,
568                        );
569             }
570        }
571    }
572
573    # Check whether we need to munge lat and long.
574    # Store them unmunged as well so commit_node can get hold of them.
575    my %prefs = OpenGuides::CGI->get_prefs_from_cookie( config => $config );
576    if ( $prefs{latlong_traditional} ) {
577        foreach my $var ( qw( latitude longitude ) ) {
578            next unless defined $vars{$var} && length $vars{$var};
579            $vars{$var."_unmunged"} = $vars{$var};
580            $vars{$var} = Geography::NationalGrid->deg2string($vars{$var});
581        }
582    }
583
584    return %vars;
585}
586
587=back
588
589=head1 AUTHOR
590
591The OpenGuides Project (openguides-dev@lists.openguides.org)
592
593=head1 COPYRIGHT
594
595  Copyright (C) 2003-2008 The OpenGuides Project.  All Rights Reserved.
596
597This module is free software; you can redistribute it and/or modify it
598under the same terms as Perl itself.
599
600=cut
601
6021;
Note: See TracBrowser for help on using the repository browser.