source: trunk/lib/OpenGuides/Template.pm

Last change on this file was 1395, checked in by bob, 9 years ago

merge changes from release branch

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