source: trunk/lib/OpenGuides.pm @ 730

Last change on this file since 730 was 730, checked in by Dominic Hargreaves, 16 years ago

Add initial google maps support, see #46 but this isn't yet a complete
implementation so leaving the bug open for now.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 35.3 KB
Line 
1package OpenGuides;
2use strict;
3
4use Carp "croak";
5use CGI;
6use CGI::Wiki::Plugin::Diff;
7use CGI::Wiki::Plugin::Locator::Grid;
8use OpenGuides::CGI;
9use OpenGuides::Template;
10use OpenGuides::Utils;
11use Time::Piece;
12use URI::Escape;
13
14use vars qw( $VERSION );
15
16$VERSION = '0.52';
17
18=head1 NAME
19
20OpenGuides - A complete web application for managing a collaboratively-written guide to a city or town.
21
22=head1 DESCRIPTION
23
24The OpenGuides software provides the framework for a collaboratively-written
25city guide.  It is similar to a wiki but provides somewhat more structured
26data storage allowing you to annotate wiki pages with information such as
27category, location, and much more.  It provides searching facilities
28including "find me everything within a certain distance of this place".
29Every page includes a link to a machine-readable (RDF) version of the page.
30
31=head1 METHODS
32
33=over
34
35=item B<new>
36
37  my $config = OpenGuides::Config->new( file => "wiki.conf" );
38  my $guide = OpenGuides->new( config => $config );
39
40=cut
41
42sub new {
43    my ($class, %args) = @_;
44    my $self = {};
45    bless $self, $class;
46    my $wiki = OpenGuides::Utils->make_wiki_object( config => $args{config} );
47    $self->{wiki} = $wiki;
48    $self->{config} = $args{config};
49    my $geo_handler = $self->config->geo_handler;
50    my $locator;
51    if ( $geo_handler == 1 ) {
52        $locator = CGI::Wiki::Plugin::Locator::Grid->new(
53                                             x => "os_x",    y => "os_y" );
54    } elsif ( $geo_handler == 2 ) {
55        $locator = CGI::Wiki::Plugin::Locator::Grid->new(
56                                             x => "osie_x",  y => "osie_y" );
57    } else {
58        $locator = CGI::Wiki::Plugin::Locator::Grid->new(
59                                             x => "easting", y => "northing" );
60    }
61    $wiki->register_plugin( plugin => $locator );
62    $self->{locator} = $locator;
63    my $differ = CGI::Wiki::Plugin::Diff->new;
64    $wiki->register_plugin( plugin => $differ );
65    $self->{differ} = $differ;
66    return $self;
67}
68
69=item B<wiki>
70
71An accessor, returns the underlying L<CGI::Wiki> object.
72
73=cut
74
75sub wiki {
76    my $self = shift;
77    return $self->{wiki};
78}
79
80=item B<config>
81
82An accessor, returns the underlying L<OpenGuides::Config> object.
83
84=cut
85
86sub config {
87    my $self = shift;
88    return $self->{config};
89}
90
91=item B<locator>
92
93An accessor, returns the underlying L<CGI::Wiki::Plugin::Locator::UK> object.
94
95=cut
96
97sub locator {
98    my $self = shift;
99    return $self->{locator};
100}
101
102=item B<differ>
103
104An accessor, returns the underlying L<CGI::Wiki::Plugin::Diff> object.
105
106=cut
107
108sub differ {
109    my $self = shift;
110    return $self->{differ};
111}
112
113=item B<display_node>
114
115  # Print node to STDOUT.
116  $guide->display_node(
117                          id      => "Calthorpe Arms",
118                          version => 2,
119                      );
120
121  # Or return output as a string (useful for writing tests).
122  $guide->display_node(
123                          id            => "Calthorpe Arms",
124                          return_output => 1,
125                      );
126
127  # Or return the hash of variables that will be passed to the template
128  # (not including those set additionally by OpenGuides::Template).
129  $guide->display_node(
130                          id             => "Calthorpe Arms",
131                          return_tt_vars => 1,
132                      );
133
134If C<version> is omitted then the latest version will be displayed.
135
136=cut
137
138sub display_node {
139    my ($self, %args) = @_;
140    my $return_output = $args{return_output} || 0;
141    my $version = $args{version};
142    my $id = $args{id} || $self->config->home_name;
143    my $wiki = $self->wiki;
144    my $config = $self->config;
145    my $oldid = $args{oldid} || '';
146    my $do_redirect = $args{redirect} || 1;
147
148    my %tt_vars;
149
150    if ( $id =~ /^(Category|Locale) (.*)$/ ) {
151        my $type = $1;
152        $tt_vars{is_indexable_node} = 1;
153        $tt_vars{index_type} = lc($type);
154        $tt_vars{index_value} = $2;
155        $tt_vars{"rss_".lc($type)."_url"} =
156                           $config->script_name . "?action=rc;format=rss;"
157                           . lc($type) . "=" . lc(CGI->escape($2));
158    }
159
160    my %current_data = $wiki->retrieve_node( $id );
161    my $current_version = $current_data{version};
162    undef $version if ($version && $version == $current_version);
163    my %criteria = ( name => $id );
164    $criteria{version} = $version if $version; # retrieve_node default is current
165
166    my %node_data = $wiki->retrieve_node( %criteria );
167
168    # Fixes passing undefined values to Text::Wikiformat if node doesn't exist.
169    my $raw        = $node_data{content} || " ";
170    my $content    = $wiki->format($raw);
171    my $modified   = $node_data{last_modified};
172    my %metadata   = %{$node_data{metadata}};
173
174    my ($wgs84_long, $wgs84_lat) = OpenGuides::Utils->get_wgs84_coords(
175                                        longitude => $metadata{longitude}[0],
176                                        latitude => $metadata{latitude}[0],
177                                        config => $config);
178    if ($args{format} && $args{format} eq 'raw') {
179      print "Content-Type: text/plain\n\n";
180      print $raw;
181      exit 0;
182    }
183   
184    my %metadata_vars = OpenGuides::Template->extract_metadata_vars(
185                            wiki     => $wiki,
186                            config   => $config,
187                            metadata => $node_data{metadata}
188                        );
189
190    %tt_vars = (
191                   %tt_vars,
192                   %metadata_vars,
193                   content       => $content,
194                   last_modified => $modified,
195                   version       => $node_data{version},
196                   node          => $id,
197                   language      => $config->default_language,
198                   oldid         => $oldid,
199                   enable_gmaps  => 1,
200                   display_google_maps => $self->get_cookie("display_google_maps"),
201                   wgs84_long    => $wgs84_long,
202                   wgs84_lat     => $wgs84_lat
203               );
204
205    if ( $raw =~ /^#REDIRECT\s+(.+?)\s*$/ ) {
206        my $redirect = $1;
207        # Strip off enclosing [[ ]] in case this is an extended link.
208        $redirect =~ s/^\[\[//;
209        $redirect =~ s/\]\]\s*$//;
210
211        # Don't redirect if the parameter "redirect" is given as 0.
212        if ($do_redirect == 0) {
213            return %tt_vars if $args{return_tt_vars};
214            $tt_vars{current} = 1;
215            my $output = $self->process_template(
216                                                  id            => $id,
217                                                  template      => "node.tt",
218                                                  tt_vars       => \%tt_vars,
219                                                );
220            return $output if $return_output;
221            print $output;
222        } elsif ( $wiki->node_exists($redirect) && $redirect ne $id && $redirect ne $oldid ) {
223            # Avoid loops by not generating redirects to the same node or the previous node.
224            my $output = $self->redirect_to_node($redirect, $id);
225            return $output if $return_output;
226            print $output;
227            exit 0;
228        }
229    }
230
231    # We've undef'ed $version above if this is the current version.
232    $tt_vars{current} = 1 unless $version;
233
234    if ($id eq "RecentChanges") {
235        $self->display_recent_changes(%args);
236    } elsif ( $id eq $self->config->home_name ) {
237        my @recent = $wiki->list_recent_changes(
238            last_n_changes => 10,
239            metadata_was   => { edit_type => "Normal edit" },
240        );
241        @recent = map {
242                          {
243                              name          => CGI->escapeHTML($_->{name}),
244                              last_modified => CGI->escapeHTML($_->{last_modified}),
245                              version       => CGI->escapeHTML($_->{version}),
246                              comment       => CGI->escapeHTML($_->{metadata}{comment}[0]),
247                              username      => CGI->escapeHTML($_->{metadata}{username}[0]),
248                              url           => $config->script_name . "?"
249                                               . CGI->escape($wiki->formatter->node_name_to_node_param($_->{name}))
250                          }
251                      } @recent;
252        $tt_vars{recent_changes} = \@recent;
253        return %tt_vars if $args{return_tt_vars};
254        my $output = $self->process_template(
255                                                id            => $id,
256                                                template      => "home_node.tt",
257                                                tt_vars       => \%tt_vars,
258                                            );
259        return $output if $return_output;
260        print $output;
261    } else {
262        return %tt_vars if $args{return_tt_vars};
263        my $output = $self->process_template(
264                                                id            => $id,
265                                                template      => "node.tt",
266                                                tt_vars       => \%tt_vars,
267                                            );
268        return $output if $return_output;
269        print $output;
270    }
271}
272
273=item B<display_recent_changes> 
274
275  $guide->display_recent_changes;
276
277As with other methods, the C<return_output> parameter can be used to
278return the output instead of printing it to STDOUT.
279
280=cut
281
282sub display_recent_changes {
283    my ($self, %args) = @_;
284    my $config = $self->config;
285    my $wiki = $self->wiki;
286    my $minor_edits = $self->get_cookie( "show_minor_edits_in_rc" );
287    my $id = $args{id} || $self->config->home_name;
288    my $return_output = $args{return_output} || 0;
289    my (%tt_vars, %recent_changes);
290    my $q = CGI->new;
291    my $since = $q->param("since");
292    if ( $since ) {
293        $tt_vars{since} = $since;
294        my $t = localtime($since); # overloaded by Time::Piece
295        $tt_vars{since_string} = $t->strftime;
296        my %criteria = ( since => $since );   
297        $criteria{metadata_was} = { edit_type => "Normal edit" }
298          unless $minor_edits;
299        my @rc = $self->{wiki}->list_recent_changes( %criteria );
300 
301        @rc = map {
302            {
303              name        => CGI->escapeHTML($_->{name}),
304              last_modified => CGI->escapeHTML($_->{last_modified}),
305              version     => CGI->escapeHTML($_->{version}),
306              comment     => CGI->escapeHTML($_->{metadata}{comment}[0]),
307              username    => CGI->escapeHTML($_->{metadata}{username}[0]),
308              host        => CGI->escapeHTML($_->{metadata}{host}[0]),
309              username_param => CGI->escape($_->{metadata}{username}[0]),
310              edit_type   => CGI->escapeHTML($_->{metadata}{edit_type}[0]),
311              url         => $config->script_name . "?"
312      . CGI->escape($wiki->formatter->node_name_to_node_param($_->{name})),
313        }
314                   } @rc;
315        if ( scalar @rc ) {
316            $recent_changes{since} = \@rc; 
317        }
318    } else {
319        for my $days ( [0, 1], [1, 7], [7, 14], [14, 30] ) {
320            my %criteria = ( between_days => $days );
321            $criteria{metadata_was} = { edit_type => "Normal edit" }
322              unless $minor_edits;
323            my @rc = $self->{wiki}->list_recent_changes( %criteria );
324
325            @rc = map {
326            {
327              name        => CGI->escapeHTML($_->{name}),
328              last_modified => CGI->escapeHTML($_->{last_modified}),
329              version     => CGI->escapeHTML($_->{version}),
330              comment     => CGI->escapeHTML($_->{metadata}{comment}[0]),
331              username    => CGI->escapeHTML($_->{metadata}{username}[0]),
332              host        => CGI->escapeHTML($_->{metadata}{host}[0]),
333              username_param => CGI->escape($_->{metadata}{username}[0]),
334              edit_type   => CGI->escapeHTML($_->{metadata}{edit_type}[0]),
335              url         => $config->script_name . "?"
336      . CGI->escape($wiki->formatter->node_name_to_node_param($_->{name})),
337        }
338                       } @rc;
339            if ( scalar @rc ) {
340                $recent_changes{$days->[1]} = \@rc;
341        }
342        }
343    }
344    $tt_vars{recent_changes} = \%recent_changes;
345    my %processing_args = (
346                            id            => $id,
347                            template      => "recent_changes.tt",
348                            tt_vars       => \%tt_vars,
349                           );
350    if ( !$since && $self->get_cookie("track_recent_changes_views") ) {
351    my $cookie =
352           OpenGuides::CGI->make_recent_changes_cookie(config => $config );
353        $processing_args{cookies} = $cookie;
354        $tt_vars{last_viewed} = OpenGuides::CGI->get_last_recent_changes_visit_from_cookie( config => $config );
355    }
356    return %tt_vars if $args{return_tt_vars};
357    my $output = $self->process_template( %processing_args );
358    return $output if $return_output;
359    print $output;
360}
361
362=item B<display_diffs>
363
364  $guide->display_diffs(
365                           id            => "Home Page",
366                           version       => 6,
367                           other_version => 5,
368                       );
369
370  # Or return output as a string (useful for writing tests).
371  my $output = $guide->display_diffs(
372                                        id            => "Home Page",
373                                        version       => 6,
374                                        other_version => 5,
375                                        return_output => 1,
376                                    );
377
378  # Or return the hash of variables that will be passed to the template
379  # (not including those set additionally by OpenGuides::Template).
380  my %vars = $guide->display_diffs(
381                                      id             => "Home Page",
382                                      version        => 6,
383                                      other_version  => 5,
384                                      return_tt_vars => 1,
385                                  );
386
387=cut
388
389sub display_diffs {
390    my ($self, %args) = @_;
391    my %diff_vars = $self->differ->differences(
392                                                  node          => $args{id},
393                                                  left_version  => $args{version},
394                                                  right_version => $args{other_version},
395                                              );
396    $diff_vars{not_deletable} = 1;
397    $diff_vars{not_editable}  = 1;
398    $diff_vars{deter_robots}  = 1;
399    return %diff_vars if $args{return_tt_vars};
400    my $output = $self->process_template(
401                                            id       => $args{id},
402                                            template => "differences.tt",
403                                            tt_vars  => \%diff_vars
404                                        );
405    return $output if $args{return_output};
406    print $output;
407}
408
409=item B<find_within_distance>
410
411  $guide->find_within_distance(
412                                  id => $node,
413                                  metres => $q->param("distance_in_metres")
414                              );
415
416=cut
417
418sub find_within_distance {
419    my ($self, %args) = @_;
420    my $node = $args{id};
421    my $metres = $args{metres};
422    my %data = $self->wiki->retrieve_node( $node );
423    my $lat = $data{metadata}{latitude}[0];
424    my $long = $data{metadata}{longitude}[0];
425    my $script_url = $self->config->script_url;
426    print CGI->redirect( $script_url . "search.cgi?lat=$lat;long=$long;distance_in_metres=$metres" );
427}
428
429=item B<show_backlinks>
430
431  $guide->show_backlinks( id => "Calthorpe Arms" );
432
433As with other methods, parameters C<return_tt_vars> and
434C<return_output> can be used to return these things instead of
435printing the output to STDOUT.
436
437=cut
438
439sub show_backlinks {
440    my ($self, %args) = @_;
441    my $wiki = $self->wiki;
442    my $formatter = $wiki->formatter;
443
444    my @backlinks = $wiki->list_backlinks( node => $args{id} );
445    my @results = map {
446                          {
447                              url   => CGI->escape($formatter->node_name_to_node_param($_)),
448                              title => CGI->escapeHTML($_)
449                          }
450                      } sort @backlinks;
451    my %tt_vars = ( results       => \@results,
452                    num_results   => scalar @results,
453                    not_deletable => 1,
454                    deter_robots  => 1,
455                    not_editable  => 1 );
456    return %tt_vars if $args{return_tt_vars};
457    my $output = OpenGuides::Template->output(
458                                                 node    => $args{id},
459                                                 wiki    => $wiki,
460                                                 config  => $self->config,
461                                                 template=>"backlink_results.tt",
462                                                 vars    => \%tt_vars,
463                                             );
464    return $output if $args{return_output};
465    print $output;
466}
467
468=item B<show_index>
469
470  $guide->show_index(
471                        type   => "category",
472                        value  => "pubs",
473                    );
474
475  # RDF version.
476  $guide->show_index(
477                        type   => "locale",
478                        value  => "Holborn",
479                        format => "rdf",
480                    );
481
482  # Or return output as a string (useful for writing tests).
483  $guide->show_index(
484                        type          => "category",
485                        value         => "pubs",
486                        return_output => 1,
487                    );
488
489=cut
490
491sub show_index {
492    my ($self, %args) = @_;
493    my $wiki = $self->wiki;
494    my $formatter = $wiki->formatter;
495    my %tt_vars;
496    my @selnodes;
497
498    if ( $args{type} and $args{value} ) {
499        if ( $args{type} eq "fuzzy_title_match" ) {
500            my %finds = $wiki->fuzzy_title_match( $args{value} );
501            @selnodes = sort { $finds{$a} <=> $finds{$b} } keys %finds;
502            $tt_vars{criterion} = {
503                type  => $args{type},  # for RDF version
504                value => $args{value}, # for RDF version
505                name  => CGI->escapeHTML("Fuzzy Title Match on '$args{value}'")
506            };
507            $tt_vars{not_editable} = 1;
508        } else {
509            @selnodes = $wiki->list_nodes_by_metadata(
510                metadata_type  => $args{type},
511                metadata_value => $args{value},
512                ignore_case    => 1
513            );
514            my $name = ucfirst($args{type}) . " $args{value}";
515            my $url = $self->config->script_name
516                      . "?"
517                      . ucfirst( $args{type} )
518                      . "_"
519                      . uri_escape(
520                                      $formatter->node_name_to_node_param($args{value})
521                                  );
522            $tt_vars{criterion} = {
523                type  => $args{type},
524                value => $args{value}, # for RDF version
525                name  => CGI->escapeHTML( $name ),
526                url   => $url
527            };
528            $tt_vars{not_editable} = 1;
529        }
530    } else {
531        @selnodes = $wiki->list_all_nodes();
532    }
533
534    my @nodes = map {
535                        {
536                            name      => $_,
537                            node_data => { $wiki->retrieve_node( name => $_ ) },
538                            param     => $formatter->node_name_to_node_param($_) }
539                        } sort @selnodes;
540
541    $tt_vars{nodes} = \@nodes;
542
543    my ($template, %conf);
544
545    if ( $args{format} ) {
546        if ( $args{format} eq "rdf" ) {
547            $template = "rdf_index.tt";
548            $conf{content_type} = "application/rdf+xml";
549        }
550        elsif ( $args{format} eq "plain" ) {
551            $template = "plain_index.tt";
552            $conf{content_type} = "text/plain";
553        } elsif ( $args{format} eq "map" ) {
554            my $q = CGI->new;
555            $tt_vars{zoom} = $q->param('zoom') || '';
556            $tt_vars{lat} = $q->param('lat') || '';
557            $tt_vars{long} = $q->param('long') || '';
558            $tt_vars{centre_long} = $self->config->centre_long;
559            $tt_vars{centre_lat} = $self->config->centre_lat;
560            $tt_vars{default_gmaps_zoom} = $self->config->default_gmaps_zoom;
561            $tt_vars{enable_gmaps} = 1;
562            $tt_vars{display_google_maps} = 1; # override for this page
563            $template = "map_index.tt";
564           
565        }
566    } else {
567        $template = "site_index.tt";
568    }
569
570    %conf = (
571                %conf,
572                node        => "$args{type} index", # KLUDGE
573                template    => $template,
574                tt_vars     => \%tt_vars,
575            );
576
577    my $output = $self->process_template( %conf );
578    return $output if $args{return_output};
579    print $output;
580}
581
582=item B<list_all_versions>
583
584  $guide->list_all_versions ( id => "Home Page" );
585
586  # Or return output as a string (useful for writing tests).
587  $guide->list_all_versions (
588                                id            => "Home Page",
589                                return_output => 1,
590                            );
591
592  # Or return the hash of variables that will be passed to the template
593  # (not including those set additionally by OpenGuides::Template).
594  $guide->list_all_versions (
595                                id             => "Home Page",
596                                return_tt_vars => 1,
597                            );
598
599=cut
600
601sub list_all_versions {
602    my ($self, %args) = @_;
603    my $return_output = $args{return_output} || 0;
604    my $node = $args{id};
605    my %curr_data = $self->wiki->retrieve_node($node);
606    my $curr_version = $curr_data{version};
607    my @history;
608    for my $version ( 1 .. $curr_version ) {
609        my %node_data = $self->wiki->retrieve_node( name    => $node,
610                                                    version => $version );
611        # $node_data{version} will be zero if this version was deleted.
612        push @history, {
613            version  => CGI->escapeHTML( $version ),
614            modified => CGI->escapeHTML( $node_data{last_modified} ),
615            username => CGI->escapeHTML( $node_data{metadata}{username}[0] ),
616            comment  => CGI->escapeHTML( $node_data{metadata}{comment}[0] ),
617                       } if $node_data{version};
618    }
619    @history = reverse @history;
620    my %tt_vars = (
621                      node          => $node,
622                      version       => $curr_version,
623                      not_deletable => 1,
624                      not_editable  => 1,
625                      deter_robots  => 1,
626                      history       => \@history
627                  );
628    return %tt_vars if $args{return_tt_vars};
629    my $output = $self->process_template(
630                                            id       => $node,
631                                            template => "node_history.tt",
632                                            tt_vars  => \%tt_vars,
633                                        );
634    return $output if $return_output;
635    print $output;
636}
637
638=item B<display_rss>
639
640  # Last ten non-minor edits to Hammersmith pages.
641  $guide->display_rss(
642                         items              => 10,
643                         ignore_minor_edits => 1,
644                         locale             => "Hammersmith",
645                     );
646
647  # All edits bob has made to pub pages in the last week.
648  $guide->display_rss(
649                         days     => 7,
650                         username => "bob",
651                         category => "Pubs",
652                     );
653
654As with other methods, the C<return_output> parameter can be used to
655return the output instead of printing it to STDOUT.
656
657=cut
658
659sub display_rss {
660    my ($self, %args) = @_;
661
662    my $return_output = $args{return_output} ? 1 : 0;
663
664    my $items = $args{items} || "";
665    my $days  = $args{days}  || "";
666    my $ignore_minor_edits = $args{ignore_minor_edits} ? 1 : 0;
667    my $username = $args{username} || "";
668    my $category = $args{category} || "";
669    my $locale   = $args{locale}   || "";
670    my %criteria = (
671                       items              => $items,
672                       days               => $days,
673                       ignore_minor_edits => $ignore_minor_edits,
674                   );
675    my %filter;
676    $filter{username} = $username if $username;
677    $filter{category} = $category if $category;
678    $filter{locale}   = $locale   if $locale;
679    if ( scalar keys %filter ) {
680        $criteria{filter_on_metadata} = \%filter;
681    }
682
683    my $rdf_writer = OpenGuides::RDF->new(
684                                             wiki       => $self->wiki,
685                                             config     => $self->config,
686                                             og_version => $VERSION,
687                                         );
688    my $output = "Content-Type: application/rdf+xml\n";
689    $output .= "Last-Modified: " . $rdf_writer->rss_timestamp( %criteria ) . "\n\n";
690    $output .= $rdf_writer->make_recentchanges_rss( %criteria );
691    return $output if $return_output;
692    print $output;
693}
694
695=item B<commit_node>
696
697  $guide->commit_node(
698                         id      => $node,
699                         cgi_obj => $q,
700                     );
701
702As with other methods, parameters C<return_tt_vars> and
703C<return_output> can be used to return these things instead of
704printing the output to STDOUT.
705
706The geographical data that you should provide in the L<CGI> object
707depends on the handler you chose in C<wiki.conf>.
708
709=over
710
711=item *
712
713B<British National Grid> - provide either C<os_x> and C<os_y> or
714C<latitude> and C<longitude>; whichever set of data you give, it will
715be converted to the other and both sets will be stored.
716
717=item *
718
719B<Irish National Grid> - provide either C<osie_x> and C<osie_y> or
720C<latitude> and C<longitude>; whichever set of data you give, it will
721be converted to the other and both sets will be stored.
722
723=item *
724
725B<UTM ellipsoid> - provide C<latitude> and C<longitude>; these will be
726converted to easting and northing and both sets of data will be stored.
727
728=back
729
730=cut
731
732sub commit_node {
733    my ($self, %args) = @_;
734    my $node = $args{id};
735    my $q = $args{cgi_obj};
736    my $return_output = $args{return_output};
737    my $wiki = $self->wiki;
738    my $config = $self->config;
739
740    my $content  = $q->param("content");
741    $content =~ s/\r\n/\n/gs;
742    my $checksum = $q->param("checksum");
743
744    my %metadata = OpenGuides::Template->extract_metadata_vars(
745        wiki    => $wiki,
746        config  => $config,
747    cgi_obj => $q
748    );
749
750    delete $metadata{website} if $metadata{website} eq 'http://';
751
752    $metadata{opening_hours_text} = $q->param("hours_text") || "";
753
754    # Pick out the unmunged versions of lat/long if they're set.
755    # (If they're not, it means they weren't munged in the first place.)
756    $metadata{latitude} = delete $metadata{latitude_unmunged}
757        if $metadata{latitude_unmunged};
758    $metadata{longitude} = delete $metadata{longitude_unmunged}
759        if $metadata{longitude_unmunged};
760
761    # Check to make sure all the indexable nodes are created
762    foreach my $type (qw(Category Locale)) {
763        my $lctype = lc($type);
764        foreach my $index (@{$metadata{$lctype}}) {
765            $index =~ s/(.*)/\u$1/;
766            my $node = $type . " " . $index;
767            # Uppercase the node name before checking for existence
768            $node =~ s/ (\S+)/ \u$1/g;
769            unless ( $wiki->node_exists($node) ) {
770                my $category = $type eq "Category" ? "Category" : "Locales";
771                $wiki->write_node(
772                                     $node,
773                                     "\@INDEX_LINK [[$node]]",
774                                     undef,
775                                     {
776                                         username => "Auto Create",
777                                         comment  => "Auto created $lctype stub page",
778                                         category => $category
779                                     }
780                                 );
781            }
782        }
783    }
784   
785    foreach my $var ( qw( summary username comment edit_type ) ) {
786        $metadata{$var} = $q->param($var) || "";
787    }
788    $metadata{host} = $ENV{REMOTE_ADDR};
789
790    # CGI::Wiki::Plugin::RSS::ModWiki wants "major_change" to be set.
791    $metadata{major_change} = ( $metadata{edit_type} eq "Normal edit" )
792                            ? 1
793                            : 0;
794
795    my $written = $wiki->write_node($node, $content, $checksum, \%metadata );
796
797    if ($written) {
798        my $output = $self->redirect_to_node($node);
799        return $output if $return_output;
800        print $output;
801    } else {
802        my %node_data = $wiki->retrieve_node($node);
803        my %tt_vars = ( checksum       => $node_data{checksum},
804                        new_content    => $content,
805                        stored_content => $node_data{content} );
806        foreach my $mdvar ( keys %metadata ) {
807            if ($mdvar eq "locales") {
808                $tt_vars{"stored_$mdvar"} = $node_data{metadata}{locale};
809                $tt_vars{"new_$mdvar"}    = $metadata{locale};
810            } elsif ($mdvar eq "categories") {
811                $tt_vars{"stored_$mdvar"} = $node_data{metadata}{category};
812                $tt_vars{"new_$mdvar"}    = $metadata{category};
813            } elsif ($mdvar eq "username" or $mdvar eq "comment"
814                      or $mdvar eq "edit_type" ) {
815                $tt_vars{$mdvar} = $metadata{$mdvar};
816            } else {
817                $tt_vars{"stored_$mdvar"} = $node_data{metadata}{$mdvar}[0];
818                $tt_vars{"new_$mdvar"}    = $metadata{$mdvar};
819            }
820        }
821        return %tt_vars if $args{return_tt_vars};
822        my $output = $self->process_template(
823                                              id       => $node,
824                                              template => "edit_conflict.tt",
825                                              tt_vars  => \%tt_vars,
826                                            );
827        return $output if $args{return_output};
828        print $output;
829    }
830}
831
832
833=item B<delete_node>
834
835  $guide->delete_node(
836                         id       => "FAQ",
837                         version  => 15,
838                         password => "beer",
839                     );
840
841C<version> is optional - if it isn't supplied then all versions of the
842node will be deleted; in other words the node will be entirely
843removed.
844
845If C<password> is not supplied then a form for entering the password
846will be displayed.
847
848As with other methods, parameters C<return_tt_vars> and
849C<return_output> can be used to return these things instead of
850printing the output to STDOUT.
851
852=cut
853
854sub delete_node {
855    my ($self, %args) = @_;
856    my $node = $args{id} or croak "No node ID supplied for deletion";
857    my $return_tt_vars = $args{return_tt_vars} || 0;
858    my $return_output = $args{return_output} || 0;
859
860    my %tt_vars = (
861                      not_editable  => 1,
862                      not_deletable => 1,
863                      deter_robots  => 1,
864                  );
865    $tt_vars{delete_version} = $args{version} || "";
866
867    my $password = $args{password};
868
869    if ($password) {
870        if ($password ne $self->config->admin_pass) {
871            return %tt_vars if $return_tt_vars;
872            my $output = $self->process_template(
873                                                    id       => $node,
874                                                    template => "delete_password_wrong.tt",
875                                                    tt_vars  => \%tt_vars,
876                                                );
877            return $output if $return_output;
878            print $output;
879        } else {
880            $self->wiki->delete_node(
881                                        name    => $node,
882                                        version => $args{version},
883                                    );
884            # Check whether any versions of this node remain.
885            my %check = $self->wiki->retrieve_node( name => $node );
886            $tt_vars{other_versions_remain} = 1 if $check{version};
887            return %tt_vars if $return_tt_vars;
888            my $output = $self->process_template(
889                                                    id       => $node,
890                                                    template => "delete_done.tt",
891                                                    tt_vars  => \%tt_vars,
892                                                );
893            return $output if $return_output;
894            print $output;
895        }
896    } else {
897        return %tt_vars if $return_tt_vars;
898        my $output = $self->process_template(
899                                                id       => $node,
900                                                template => "delete_confirm.tt",
901                                                tt_vars  => \%tt_vars,
902                                            );
903        return $output if $return_output;
904        print $output;
905    }
906}
907
908sub process_template {
909    my ($self, %args) = @_;
910    my %output_conf = (
911                          wiki     => $self->wiki,
912                          config   => $self->config,
913                          node     => $args{id},
914                          template => $args{template},
915                          vars     => $args{tt_vars},
916                          cookies  => $args{cookies},
917                      );
918    if ( $args{content_type} ) {
919        $output_conf{content_type} = $args{content_type};
920    }
921    return OpenGuides::Template->output( %output_conf );
922}
923
924sub redirect_to_node {
925    my ($self, $node, $redirected_from) = @_;
926   
927    my $script_url = $self->config->script_url;
928    my $script_name = $self->config->script_name;
929    my $formatter = $self->wiki->formatter;
930
931    my $id = $formatter->node_name_to_node_param( $node );
932    my $oldid;
933    $oldid = $formatter->node_name_to_node_param( $redirected_from ) if $redirected_from;
934
935    my $redir_param = "$script_url$script_name?";
936    $redir_param .= 'id=' if $oldid;
937    $redir_param .= $id;
938    $redir_param .= ";oldid=$oldid" if $oldid;
939
940    return CGI->redirect( $redir_param );
941}
942
943sub get_cookie {
944    my $self = shift;
945    my $config = $self->config;
946    my $pref_name = shift or return "";
947    my %cookie_data = OpenGuides::CGI->get_prefs_from_cookie(config=>$config);
948    return $cookie_data{$pref_name};
949}
950
951=back
952
953=head1 BUGS AND CAVEATS
954
955UTF8 data are currently not handled correctly throughout.
956
957Other bugs are documented at
958L<http://dev.openguides.org/>
959
960=head1 SEE ALSO
961
962=over 4
963
964=item * L<http://london.openguides.org/|The Open Guide to London>, the first and biggest OpenGuides site.
965
966=item * L<http://openguides.org/|The OpenGuides website>, with a list of all live OpenGuides installs.
967
968=item * L<CGI::Wiki>, the Wiki toolkit which does the heavy lifting for OpenGuides
969
970=back
971
972=head1 FEEDBACK
973
974If you have a question, a bug report, or a patch, or you're interested
975in joining the development team, please contact openguides-dev@openguides.org
976(moderated mailing list, will reach all current developers but you'll have
977to wait for your post to be approved) or file a bug report at
978L<http://dev.openguides.org/>
979
980=head1 AUTHOR
981
982The OpenGuides Project (openguides-dev@openguides.org)
983
984=head1 COPYRIGHT
985
986     Copyright (C) 2003-2005 The OpenGuides Project.  All Rights Reserved.
987
988The OpenGuides distribution is free software; you can redistribute it
989and/or modify it under the same terms as Perl itself.
990
991=head1 CREDITS
992
993Programming by Dominic Hargreaves, Earle Martin, Kake Pugh, and Ivor
994Williams.  Testing and bug reporting by Billy Abbott, Jody Belka,
995Kerry Bosworth, Simon Cozens, Cal Henderson, Steve Jolly, and Bob
996Walker (among others).  Much of the Module::Build stuff copied from
997the Siesta project L<http://siesta.unixbeard.net/>
998
999=cut
1000
10011;
Note: See TracBrowser for help on using the repository browser.