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

Last change on this file since 1067 was 1054, checked in by Dominic Hargreaves, 14 years ago

Add support in output routine for specifying HTTP status code (see #102)

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