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

Last change on this file since 578 was 578, checked in by Dominic Hargreaves, 17 years ago

copyright updates.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 18.2 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 Config::Tiny;
30  use OpenGuides::Utils;
31  use OpenGuides::Template;
32
33  my $config = Config::Tiny->read('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 variables supplied in C<vars> are passed through to the template
60specified.  Additional Template Toolkit variables are automatically
61set and passed through as well, as described below.  B<Note:>
62variables set in C<vars> will over-ride any variables of the same name
63in 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=back
90
91=over
92
93If C<node> is supplied:
94
95=item * C<node_name>
96
97=item * C<node_param> (the node name escaped for use in URLs)
98
99=back
100
101Content-Type: defaults to C<text/html> and is omitted if the
102C<content_type> arg is explicitly set to the blank string.
103
104=cut
105
106sub output {
107    my ($class, %args) = @_;
108    croak "No template supplied" unless $args{template};
109    my $config = $args{config} or croak "No config supplied";
110    my $template_path = $config->{_}->{template_path};
111    my $custom_template_path = $config->{_}->{custom_template_path} || "";
112    my $tt = Template->new( { INCLUDE_PATH => "$custom_template_path:$template_path" } );
113
114    my $script_name = $config->{_}->{script_name};
115    my $script_url  = $config->{_}->{script_url};
116
117    # Ensure that script_url ends in a '/' - this is done in Build.PL but
118    # we need to allow for people editing the config file by hand later.
119    $script_url .= "/" unless $script_url =~ /\/$/;
120
121    # Check cookie to see if we need to set the formatting_rules_link.
122    my ($formatting_rules_link, $omit_help_links);
123    my $formatting_rules_node = $config->{_}->{formatting_rules_node} ||"";
124    my %cookie_data = OpenGuides::CGI->get_prefs_from_cookie(config=>$config);
125    if ( $cookie_data{omit_help_links} ) {
126        $omit_help_links = 1;
127    } else {
128        if ( $formatting_rules_node ) {
129            $formatting_rules_link = $script_url . $script_name . "?"
130                                   . uri_escape($args{wiki}->formatter->node_name_to_node_param($formatting_rules_node));
131        }
132    }
133
134    my $enable_page_deletion = 0;
135    if ( $config->{_}->{enable_page_deletion}
136         and ( lc($config->{_}->{enable_page_deletion}) eq "y"
137               or $config->{_}->{enable_page_deletion} eq "1" )
138       ) {
139        $enable_page_deletion = 1;
140    }
141
142    my $tt_vars = { site_name             => $config->{_}->{site_name},
143                    cgi_url               => $script_name,
144                    full_cgi_url          => $script_url . $script_name,
145                    contact_email         => $config->{_}->{contact_email},
146                    stylesheet            => $config->{_}->{stylesheet_url},
147                    home_link             => $script_url . $script_name,
148                    home_name             => $config->{_}->{home_name},
149                    navbar_on_home_page   => $config->{_}->{navbar_on_home_page},
150                    omit_help_links       => $omit_help_links,
151                    formatting_rules_link => $formatting_rules_link,
152                    formatting_rules_node => $formatting_rules_node,
153                    openguides_version    => $OpenGuides::VERSION,
154                    enable_page_deletion  => $enable_page_deletion,
155                    language              => $config->{_}->{default_language},
156    };
157
158    if ($args{node}) {
159        $tt_vars->{node_name} = CGI->escapeHTML($args{node});
160        $tt_vars->{node_param} = CGI->escape($args{wiki}->formatter->node_name_to_node_param($args{node}));
161    }
162
163    # Now set further TT variables if explicitly supplied - do this last
164    # as these override auto-set ones.
165    $tt_vars = { %$tt_vars, %{ $args{vars} || {} } };
166
167    my $header = "";
168    unless ( defined $args{content_type} and $args{content_type} eq "" ) {
169        $header = CGI::header( -cookie => $args{cookies} );
170    }
171
172    # vile hack
173    my %field_vars = OpenGuides::Template->extract_metadata_vars(
174                                        wiki                 => $args{wiki},
175                                        config               => $config,
176                                        set_coord_field_vars => 1,
177                                        metadata => {},
178                                                           );
179    $tt_vars = { %field_vars, %$tt_vars };
180
181    my $output;
182    $tt->process( $args{template}, $tt_vars, \$output );
183
184    $output ||= qq(<html><head><title>ERROR</title></head><body><p>
185                   Failed to process template: )
186              . $tt->error
187              . qq(</p></body></html>);
188
189    return $header . $output;
190}
191
192=item B<extract_metadata_vars>
193
194  my %node_data = $wiki->retrieve_node( "Home Page" );
195
196  my %metadata_vars = OpenGuides::Template->extract_metadata_vars(
197                                        wiki     => $wiki,
198                                        config   => $config,
199                                        metadata => $node_data{metadata} );
200
201  # -- or --
202
203  my %metadata_vars = OpenGuides::Template->extract_metadata_vars(
204                                        wiki     => $wiki,
205                                        config   => $config,
206                                        cgi_obj  => $q );
207
208  # -- then --
209
210  print OpenGuides::Template->output( wiki     => $wiki,
211                                      config   => $config,
212                                      template => "node.tt",
213                                      vars     => { foo => "bar",
214                                                    %metadata_vars }
215                                     );
216
217Picks out things like categories, locales, phone number etc from
218EITHER the metadata hash returned by L<CGI::Wiki> OR the query
219parameters in a L<CGI> object, and packages them nicely for passing to
220templates or storing in L<CGI::Wiki> datastore.  If you supply both
221C<metadata> and C<cgi_obj> then C<metadata> will take precedence, but
222don't do that.
223
224The variables C<dist_field>, C<coord_field_1>, C<coord_field_1_name>,
225C<coord_field_1_value>, C<coord_field_2>, C<coord_field_2_name>, and
226C<coord_field_2_value>, which are used to create various forms, will
227only be set if I<either> C<metadata> is supplied I<or>
228C<set_coord_field_vars> is true, to prevent these values from being
229stored in the database on a node commit.
230
231=cut
232
233sub extract_metadata_vars {
234    my ($class, %args) = @_;
235    my %metadata = %{$args{metadata} || {} };
236    my $q = $args{cgi_obj};
237    my $formatter = $args{wiki}->formatter;
238    my $config = $args{config};
239    my $script_name = $config->{_}->{script_name};
240
241    # Categories and locales are displayed as links in the page footer.
242    # We return these twice, as eg 'category' being a simple array of
243    # category names, but 'categories' being an array of hashrefs including
244    # a URL too.  This is ick.
245    my (@catlist, @loclist);
246    if ( $args{metadata} ) {
247        @catlist = @{ $metadata{category} || [] };
248        @loclist = @{ $metadata{locale}   || [] };
249    } else {
250        my $categories_text = $q->param('categories');
251        my $locales_text    = $q->param('locales');
252        @catlist = sort split("\r\n", $categories_text);
253        @loclist = sort split("\r\n", $locales_text);
254    }
255
256    my @categories = map { { name => $_,
257                             url  => "$script_name?Category_"
258            . uri_escape($formatter->node_name_to_node_param($_)) } } @catlist;
259
260    my @locales    = map { { name => $_,
261                             url  => "$script_name?Locale_"
262            . uri_escape($formatter->node_name_to_node_param($_)) } } @loclist;
263
264    # The 'website' attribute might contain a URL so we wiki-format it here
265    # rather than just CGI::escapeHTMLing it all in the template.
266    my $website = $args{metadata} ? $metadata{website}[0]
267                                  : $q->param("website");
268    my $formatted_website_text = "";
269    if ( $website ) {
270        $formatted_website_text = $class->format_website_text(
271            formatter => $formatter,
272            text      => $website );
273    }
274
275    my $hours_text = $args{metadata} ? $metadata{opening_hours_text}[0]
276                                     : $q->param("hours_text");
277    my %vars = (
278        categories             => \@categories,
279        locales                => \@locales,
280        category               => \@catlist,
281        locale                 => \@loclist,
282        formatted_website_text => $formatted_website_text,
283        hours_text             => $hours_text
284    );
285
286    if ( $args{metadata} ) {
287        foreach my $var ( qw( phone fax address postcode os_x os_y osie_x
288                              osie_y latitude longitude map_link website) ) {
289            $vars{$var} = $metadata{$var}[0];
290        }
291        # Data for the distance search forms on the node display.
292        my $geo_handler = $config->{_}{geo_handler} || 1;
293        if ( $geo_handler == 1 ) {
294            %vars = (
295                      %vars,
296                      coord_field_1       => "os_x",
297                      coord_field_2       => "os_y",
298                      dist_field          => "os_dist",
299                      coord_field_1_name  => "OS X coordinate",
300                      coord_field_2_name  => "OS Y coordinate",
301                      coord_field_1_value => $metadata{os_x}[0],
302                      coord_field_2_value => $metadata{os_y}[0],
303                    );
304        } elsif ( $geo_handler == 2 ) {
305            %vars = (
306                      %vars,
307                      coord_field_1       => "osie_x",
308                      coord_field_2       => "osie_y",
309                      dist_field          => "osie_dist",
310                      coord_field_1_name  =>"Irish National Grid X coordinate",
311                      coord_field_2_name  =>"Irish National Grid Y coordinate",
312                      coord_field_1_value => $metadata{osie_x}[0],
313                      coord_field_2_value => $metadata{osie_y}[0],
314                    );
315        } else {
316            %vars = (
317                      %vars,
318                      coord_field_1       => "latitude",
319                      coord_field_2       => "longitude",
320                      dist_field          => "latlong_dist",
321                      coord_field_1_name  => "Latitude (decimal)",
322                      coord_field_2_name  => "Longitude (decimal)",
323                      coord_field_1_value => $metadata{latitude}[0],
324                      coord_field_2_value => $metadata{longitude}[0],
325                    );
326        }
327    } else {
328        foreach my $var ( qw( phone fax address postcode map_link website) ) {
329            $vars{$var} = $q->param($var);
330        }
331
332        my $geo_handler = $config->{_}{geo_handler} || 1;
333        if ( $geo_handler == 1 ) {
334            require Geography::NationalGrid::GB;
335            my $os_x   = $q->param("os_x");
336            my $os_y   = $q->param("os_y");
337            my $lat    = $q->param("latitude");
338            my $long   = $q->param("longitude");
339
340            # Trim whitespace - trailing whitespace buggers up the
341            # integerification by postgres and it's an easy mistake to
342            # make when typing into a form.
343            $os_x =~ s/\s+//;
344            $os_y =~ s/\s+//;
345
346            # If we were sent x and y, work out lat/long; and vice versa.
347            if ( $os_x && $os_y ) {
348                my $point = Geography::NationalGrid::GB->new( Easting =>$os_x,
349                                                              Northing=>$os_y);
350                $lat  = sprintf("%.6f", $point->latitude);
351                $long = sprintf("%.6f", $point->longitude);
352            } elsif ( $lat && $long ) {
353                my $point = Geography::NationalGrid::GB->new(Latitude =>$lat,
354                                                             Longitude=>$long);
355                $os_x = $point->easting;
356                $os_y = $point->northing;
357            }
358            if ( $os_x && $os_y ) {
359                %vars = (
360                          %vars,
361                          latitude  => $lat,
362                          longitude => $long,
363                          os_x      => $os_x,
364                          os_y      => $os_y,
365                        );
366            }
367            if ( $args{set_coord_field_vars} ) {
368                %vars = (
369                          %vars,
370                          coord_field_1       => "os_x",
371                          coord_field_2       => "os_y",
372                          dist_field          => "os_dist",
373                          coord_field_1_name  => "OS X coordinate",
374                          coord_field_2_name  => "OS Y coordinate",
375                          coord_field_1_value => $os_x,
376                          coord_field_2_value => $os_y,
377                        );
378            }
379        } elsif ( $geo_handler == 2 ) {
380            require Geography::NationalGrid::IE;
381            my $osie_x = $q->param("osie_x");
382            my $osie_y = $q->param("osie_y");
383            my $lat    = $q->param("latitude");
384            my $long   = $q->param("longitude");
385
386            # Trim whitespace - trailing whitespace buggers up the
387            # integerification by postgres and it's an easy mistake to
388            # make when typing into a form.
389            $osie_x =~ s/\s+//;
390            $osie_y =~ s/\s+//;
391
392            # If we were sent x and y, work out lat/long; and vice versa.
393            if ( $osie_x && $osie_y ) {
394                my $point = Geography::NationalGrid::IE->new(Easting=>$osie_x,
395                                                            Northing=>$osie_y);
396                $lat = sprintf("%.6f", $point->latitude);
397                $long = sprintf("%.6f", $point->longitude);
398            } elsif ( $lat && $long ) {
399                my $point = Geography::NationalGrid::GB->new(Latitude =>$lat,
400                                                             Longitude=>$long);
401                $osie_x = $point->easting;
402                $osie_y = $point->northing;
403            }
404            if ( $osie_x && $osie_y ) {
405                %vars = (
406                          %vars,
407                          latitude  => $lat,
408                          longitude => $long,
409                          osie_x    => $osie_x,
410                          osie_y    => $osie_y,
411                        );
412            }
413            if ( $args{set_coord_field_vars} ) {
414                %vars = (
415                          %vars,
416                          coord_field_1       => "osie_x",
417                          coord_field_2       => "osie_y",
418                          dist_field          => "osie_dist",
419                     coord_field_1_name  => "Irish National Grid X coordinate",
420                     coord_field_2_name  => "Irish National Grid Y coordinate",
421                          coord_field_1_value => $osie_x,
422                          coord_field_2_value => $osie_y,
423                        );
424            }
425        } elsif ( $geo_handler == 3 ) {
426            require Geo::Coordinates::UTM;
427            my $lat    = $q->param("latitude");
428            my $long   = $q->param("longitude");
429            if ( $lat && $long ) {
430                my ($zone, $easting, $northing) =
431                 Geo::Coordinates::UTM::latlon_to_utm( $config->{_}{ellipsoid},
432                                                       $lat, $long );
433                $easting  =~ s/\..*//; # chop off decimal places
434                $northing =~ s/\..*//; # - metre accuracy enough
435                %vars = ( %vars,
436                          latitude  => $lat,
437                          longitude => $long,
438                          easting   => $easting,
439                          northing  => $northing,
440                        );
441            }
442            if ( $args{set_coord_field_vars} ) {
443                %vars = (
444                          %vars,
445                          coord_field_1       => "latitude",
446                          coord_field_2       => "longitude",
447                          dist_field          => "latlong_dist",
448                          coord_field_1_name  => "Latitude (decimal)",
449                          coord_field_2_name  => "Longitude (decimal)",
450                          coord_field_1_value => $lat,
451                          coord_field_2_value => $long,
452                        );
453            }
454        }
455    }
456
457    # Check whether we need to munge lat and long.
458    # Store them unmunged as well so commit_node can get hold of them.
459    my %prefs = OpenGuides::CGI->get_prefs_from_cookie( config => $config );
460    if ( $prefs{latlong_traditional} ) {
461        foreach my $var ( qw( latitude longitude ) ) {
462            next unless defined $vars{$var};
463            $vars{$var."_unmunged"} = $vars{$var};
464            $vars{$var} = Geography::NationalGrid->deg2string($vars{$var});
465        }
466    }
467
468    return %vars;
469}
470
471sub format_website_text {
472    my ($class, %args) = @_;
473    my ($formatter, $text) = @args{ qw( formatter text ) };
474    my $formatted = $formatter->format($text);
475
476    # Strip out paragraph markers put in by formatter since we want this
477    # to be a single string to put in a <ul>.
478    $formatted =~ s/<p>//g;
479    $formatted =~ s/<\/p>//g;
480
481    return $formatted;
482}
483
484
485=back
486
487=head1 AUTHOR
488
489The OpenGuides Project (openguides-dev@openguides.org)
490
491=head1 COPYRIGHT
492
493  Copyright (C) 2003-2004 The OpenGuides Project.  All Rights Reserved.
494
495This module is free software; you can redistribute it and/or modify it
496under the same terms as Perl itself.
497
498=cut
499
5001;
Note: See TracBrowser for help on using the repository browser.