source: trunk/lib/OpenGuides.pm @ 752

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

More mod_perl fixes.

  • 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      return 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            return 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    my $q = CGI->new;
427    print $q->redirect( $script_url . "search.cgi?lat=$lat;long=$long;distance_in_metres=$metres" );
428}
429
430=item B<show_backlinks>
431
432  $guide->show_backlinks( id => "Calthorpe Arms" );
433
434As with other methods, parameters C<return_tt_vars> and
435C<return_output> can be used to return these things instead of
436printing the output to STDOUT.
437
438=cut
439
440sub show_backlinks {
441    my ($self, %args) = @_;
442    my $wiki = $self->wiki;
443    my $formatter = $wiki->formatter;
444
445    my @backlinks = $wiki->list_backlinks( node => $args{id} );
446    my @results = map {
447                          {
448                              url   => CGI->escape($formatter->node_name_to_node_param($_)),
449                              title => CGI->escapeHTML($_)
450                          }
451                      } sort @backlinks;
452    my %tt_vars = ( results       => \@results,
453                    num_results   => scalar @results,
454                    not_deletable => 1,
455                    deter_robots  => 1,
456                    not_editable  => 1 );
457    return %tt_vars if $args{return_tt_vars};
458    my $output = OpenGuides::Template->output(
459                                                 node    => $args{id},
460                                                 wiki    => $wiki,
461                                                 config  => $self->config,
462                                                 template=>"backlink_results.tt",
463                                                 vars    => \%tt_vars,
464                                             );
465    return $output if $args{return_output};
466    print $output;
467}
468
469=item B<show_index>
470
471  $guide->show_index(
472                        type   => "category",
473                        value  => "pubs",
474                    );
475
476  # RDF version.
477  $guide->show_index(
478                        type   => "locale",
479                        value  => "Holborn",
480                        format => "rdf",
481                    );
482
483  # Or return output as a string (useful for writing tests).
484  $guide->show_index(
485                        type          => "category",
486                        value         => "pubs",
487                        return_output => 1,
488                    );
489
490=cut
491
492sub show_index {
493    my ($self, %args) = @_;
494    my $wiki = $self->wiki;
495    my $formatter = $wiki->formatter;
496    my %tt_vars;
497    my @selnodes;
498
499    if ( $args{type} and $args{value} ) {
500        if ( $args{type} eq "fuzzy_title_match" ) {
501            my %finds = $wiki->fuzzy_title_match( $args{value} );
502            @selnodes = sort { $finds{$a} <=> $finds{$b} } keys %finds;
503            $tt_vars{criterion} = {
504                type  => $args{type},  # for RDF version
505                value => $args{value}, # for RDF version
506                name  => CGI->escapeHTML("Fuzzy Title Match on '$args{value}'")
507            };
508            $tt_vars{not_editable} = 1;
509        } else {
510            @selnodes = $wiki->list_nodes_by_metadata(
511                metadata_type  => $args{type},
512                metadata_value => $args{value},
513                ignore_case    => 1
514            );
515            my $name = ucfirst($args{type}) . " $args{value}";
516            my $url = $self->config->script_name
517                      . "?"
518                      . ucfirst( $args{type} )
519                      . "_"
520                      . uri_escape(
521                                      $formatter->node_name_to_node_param($args{value})
522                                  );
523            $tt_vars{criterion} = {
524                type  => $args{type},
525                value => $args{value}, # for RDF version
526                name  => CGI->escapeHTML( $name ),
527                url   => $url
528            };
529            $tt_vars{not_editable} = 1;
530        }
531    } else {
532        @selnodes = $wiki->list_all_nodes();
533    }
534
535    my @nodes = map {
536                        {
537                            name      => $_,
538                            node_data => { $wiki->retrieve_node( name => $_ ) },
539                            param     => $formatter->node_name_to_node_param($_) }
540                        } sort @selnodes;
541
542    $tt_vars{nodes} = \@nodes;
543
544    my ($template, %conf);
545
546    if ( $args{format} ) {
547        if ( $args{format} eq "rdf" ) {
548            $template = "rdf_index.tt";
549            $conf{content_type} = "application/rdf+xml";
550        }
551        elsif ( $args{format} eq "plain" ) {
552            $template = "plain_index.tt";
553            $conf{content_type} = "text/plain";
554        } elsif ( $args{format} eq "map" ) {
555            my $q = CGI->new;
556            $tt_vars{zoom} = $q->param('zoom') || '';
557            $tt_vars{lat} = $q->param('lat') || '';
558            $tt_vars{long} = $q->param('long') || '';
559            $tt_vars{centre_long} = $self->config->centre_long;
560            $tt_vars{centre_lat} = $self->config->centre_lat;
561            $tt_vars{default_gmaps_zoom} = $self->config->default_gmaps_zoom;
562            $tt_vars{enable_gmaps} = 1;
563            $tt_vars{display_google_maps} = 1; # override for this page
564            $template = "map_index.tt";
565           
566        }
567    } else {
568        $template = "site_index.tt";
569    }
570
571    %conf = (
572                %conf,
573                node        => "$args{type} index", # KLUDGE
574                template    => $template,
575                tt_vars     => \%tt_vars,
576            );
577
578    my $output = $self->process_template( %conf );
579    return $output if $args{return_output};
580    print $output;
581}
582
583=item B<list_all_versions>
584
585  $guide->list_all_versions ( id => "Home Page" );
586
587  # Or return output as a string (useful for writing tests).
588  $guide->list_all_versions (
589                                id            => "Home Page",
590                                return_output => 1,
591                            );
592
593  # Or return the hash of variables that will be passed to the template
594  # (not including those set additionally by OpenGuides::Template).
595  $guide->list_all_versions (
596                                id             => "Home Page",
597                                return_tt_vars => 1,
598                            );
599
600=cut
601
602sub list_all_versions {
603    my ($self, %args) = @_;
604    my $return_output = $args{return_output} || 0;
605    my $node = $args{id};
606    my %curr_data = $self->wiki->retrieve_node($node);
607    my $curr_version = $curr_data{version};
608    my @history;
609    for my $version ( 1 .. $curr_version ) {
610        my %node_data = $self->wiki->retrieve_node( name    => $node,
611                                                    version => $version );
612        # $node_data{version} will be zero if this version was deleted.
613        push @history, {
614            version  => CGI->escapeHTML( $version ),
615            modified => CGI->escapeHTML( $node_data{last_modified} ),
616            username => CGI->escapeHTML( $node_data{metadata}{username}[0] ),
617            comment  => CGI->escapeHTML( $node_data{metadata}{comment}[0] ),
618                       } if $node_data{version};
619    }
620    @history = reverse @history;
621    my %tt_vars = (
622                      node          => $node,
623                      version       => $curr_version,
624                      not_deletable => 1,
625                      not_editable  => 1,
626                      deter_robots  => 1,
627                      history       => \@history
628                  );
629    return %tt_vars if $args{return_tt_vars};
630    my $output = $self->process_template(
631                                            id       => $node,
632                                            template => "node_history.tt",
633                                            tt_vars  => \%tt_vars,
634                                        );
635    return $output if $return_output;
636    print $output;
637}
638
639=item B<display_rss>
640
641  # Last ten non-minor edits to Hammersmith pages.
642  $guide->display_rss(
643                         items              => 10,
644                         ignore_minor_edits => 1,
645                         locale             => "Hammersmith",
646                     );
647
648  # All edits bob has made to pub pages in the last week.
649  $guide->display_rss(
650                         days     => 7,
651                         username => "bob",
652                         category => "Pubs",
653                     );
654
655As with other methods, the C<return_output> parameter can be used to
656return the output instead of printing it to STDOUT.
657
658=cut
659
660sub display_rss {
661    my ($self, %args) = @_;
662
663    my $return_output = $args{return_output} ? 1 : 0;
664
665    my $items = $args{items} || "";
666    my $days  = $args{days}  || "";
667    my $ignore_minor_edits = $args{ignore_minor_edits} ? 1 : 0;
668    my $username = $args{username} || "";
669    my $category = $args{category} || "";
670    my $locale   = $args{locale}   || "";
671    my %criteria = (
672                       items              => $items,
673                       days               => $days,
674                       ignore_minor_edits => $ignore_minor_edits,
675                   );
676    my %filter;
677    $filter{username} = $username if $username;
678    $filter{category} = $category if $category;
679    $filter{locale}   = $locale   if $locale;
680    if ( scalar keys %filter ) {
681        $criteria{filter_on_metadata} = \%filter;
682    }
683
684    my $rdf_writer = OpenGuides::RDF->new(
685                                             wiki       => $self->wiki,
686                                             config     => $self->config,
687                                             og_version => $VERSION,
688                                         );
689    my $output = "Content-Type: application/rdf+xml\n";
690    $output .= "Last-Modified: " . $rdf_writer->rss_timestamp( %criteria ) . "\n\n";
691    $output .= $rdf_writer->make_recentchanges_rss( %criteria );
692    return $output if $return_output;
693    print $output;
694}
695
696=item B<commit_node>
697
698  $guide->commit_node(
699                         id      => $node,
700                         cgi_obj => $q,
701                     );
702
703As with other methods, parameters C<return_tt_vars> and
704C<return_output> can be used to return these things instead of
705printing the output to STDOUT.
706
707The geographical data that you should provide in the L<CGI> object
708depends on the handler you chose in C<wiki.conf>.
709
710=over
711
712=item *
713
714B<British National Grid> - provide either C<os_x> and C<os_y> or
715C<latitude> and C<longitude>; whichever set of data you give, it will
716be converted to the other and both sets will be stored.
717
718=item *
719
720B<Irish National Grid> - provide either C<osie_x> and C<osie_y> or
721C<latitude> and C<longitude>; whichever set of data you give, it will
722be converted to the other and both sets will be stored.
723
724=item *
725
726B<UTM ellipsoid> - provide C<latitude> and C<longitude>; these will be
727converted to easting and northing and both sets of data will be stored.
728
729=back
730
731=cut
732
733sub commit_node {
734    my ($self, %args) = @_;
735    my $node = $args{id};
736    my $q = $args{cgi_obj};
737    my $return_output = $args{return_output};
738    my $wiki = $self->wiki;
739    my $config = $self->config;
740
741    my $content  = $q->param("content");
742    $content =~ s/\r\n/\n/gs;
743    my $checksum = $q->param("checksum");
744
745    my %metadata = OpenGuides::Template->extract_metadata_vars(
746        wiki    => $wiki,
747        config  => $config,
748    cgi_obj => $q
749    );
750
751    delete $metadata{website} if $metadata{website} eq 'http://';
752
753    $metadata{opening_hours_text} = $q->param("hours_text") || "";
754
755    # Pick out the unmunged versions of lat/long if they're set.
756    # (If they're not, it means they weren't munged in the first place.)
757    $metadata{latitude} = delete $metadata{latitude_unmunged}
758        if $metadata{latitude_unmunged};
759    $metadata{longitude} = delete $metadata{longitude_unmunged}
760        if $metadata{longitude_unmunged};
761
762    # Check to make sure all the indexable nodes are created
763    foreach my $type (qw(Category Locale)) {
764        my $lctype = lc($type);
765        foreach my $index (@{$metadata{$lctype}}) {
766            $index =~ s/(.*)/\u$1/;
767            my $node = $type . " " . $index;
768            # Uppercase the node name before checking for existence
769            $node =~ s/ (\S+)/ \u$1/g;
770            unless ( $wiki->node_exists($node) ) {
771                my $category = $type eq "Category" ? "Category" : "Locales";
772                $wiki->write_node(
773                                     $node,
774                                     "\@INDEX_LINK [[$node]]",
775                                     undef,
776                                     {
777                                         username => "Auto Create",
778                                         comment  => "Auto created $lctype stub page",
779                                         category => $category
780                                     }
781                                 );
782            }
783        }
784    }
785   
786    foreach my $var ( qw( summary username comment edit_type ) ) {
787        $metadata{$var} = $q->param($var) || "";
788    }
789    $metadata{host} = $ENV{REMOTE_ADDR};
790
791    # CGI::Wiki::Plugin::RSS::ModWiki wants "major_change" to be set.
792    $metadata{major_change} = ( $metadata{edit_type} eq "Normal edit" )
793                            ? 1
794                            : 0;
795
796    my $written = $wiki->write_node($node, $content, $checksum, \%metadata );
797
798    if ($written) {
799        my $output = $self->redirect_to_node($node);
800        return $output if $return_output;
801        print $output;
802    } else {
803        my %node_data = $wiki->retrieve_node($node);
804        my %tt_vars = ( checksum       => $node_data{checksum},
805                        new_content    => $content,
806                        stored_content => $node_data{content} );
807        foreach my $mdvar ( keys %metadata ) {
808            if ($mdvar eq "locales") {
809                $tt_vars{"stored_$mdvar"} = $node_data{metadata}{locale};
810                $tt_vars{"new_$mdvar"}    = $metadata{locale};
811            } elsif ($mdvar eq "categories") {
812                $tt_vars{"stored_$mdvar"} = $node_data{metadata}{category};
813                $tt_vars{"new_$mdvar"}    = $metadata{category};
814            } elsif ($mdvar eq "username" or $mdvar eq "comment"
815                      or $mdvar eq "edit_type" ) {
816                $tt_vars{$mdvar} = $metadata{$mdvar};
817            } else {
818                $tt_vars{"stored_$mdvar"} = $node_data{metadata}{$mdvar}[0];
819                $tt_vars{"new_$mdvar"}    = $metadata{$mdvar};
820            }
821        }
822        return %tt_vars if $args{return_tt_vars};
823        my $output = $self->process_template(
824                                              id       => $node,
825                                              template => "edit_conflict.tt",
826                                              tt_vars  => \%tt_vars,
827                                            );
828        return $output if $args{return_output};
829        print $output;
830    }
831}
832
833
834=item B<delete_node>
835
836  $guide->delete_node(
837                         id       => "FAQ",
838                         version  => 15,
839                         password => "beer",
840                     );
841
842C<version> is optional - if it isn't supplied then all versions of the
843node will be deleted; in other words the node will be entirely
844removed.
845
846If C<password> is not supplied then a form for entering the password
847will be displayed.
848
849As with other methods, parameters C<return_tt_vars> and
850C<return_output> can be used to return these things instead of
851printing the output to STDOUT.
852
853=cut
854
855sub delete_node {
856    my ($self, %args) = @_;
857    my $node = $args{id} or croak "No node ID supplied for deletion";
858    my $return_tt_vars = $args{return_tt_vars} || 0;
859    my $return_output = $args{return_output} || 0;
860
861    my %tt_vars = (
862                      not_editable  => 1,
863                      not_deletable => 1,
864                      deter_robots  => 1,
865                  );
866    $tt_vars{delete_version} = $args{version} || "";
867
868    my $password = $args{password};
869
870    if ($password) {
871        if ($password ne $self->config->admin_pass) {
872            return %tt_vars if $return_tt_vars;
873            my $output = $self->process_template(
874                                                    id       => $node,
875                                                    template => "delete_password_wrong.tt",
876                                                    tt_vars  => \%tt_vars,
877                                                );
878            return $output if $return_output;
879            print $output;
880        } else {
881            $self->wiki->delete_node(
882                                        name    => $node,
883                                        version => $args{version},
884                                    );
885            # Check whether any versions of this node remain.
886            my %check = $self->wiki->retrieve_node( name => $node );
887            $tt_vars{other_versions_remain} = 1 if $check{version};
888            return %tt_vars if $return_tt_vars;
889            my $output = $self->process_template(
890                                                    id       => $node,
891                                                    template => "delete_done.tt",
892                                                    tt_vars  => \%tt_vars,
893                                                );
894            return $output if $return_output;
895            print $output;
896        }
897    } else {
898        return %tt_vars if $return_tt_vars;
899        my $output = $self->process_template(
900                                                id       => $node,
901                                                template => "delete_confirm.tt",
902                                                tt_vars  => \%tt_vars,
903                                            );
904        return $output if $return_output;
905        print $output;
906    }
907}
908
909sub process_template {
910    my ($self, %args) = @_;
911    my %output_conf = (
912                          wiki     => $self->wiki,
913                          config   => $self->config,
914                          node     => $args{id},
915                          template => $args{template},
916                          vars     => $args{tt_vars},
917                          cookies  => $args{cookies},
918                      );
919    if ( $args{content_type} ) {
920        $output_conf{content_type} = $args{content_type};
921    }
922    return OpenGuides::Template->output( %output_conf );
923}
924
925sub redirect_to_node {
926    my ($self, $node, $redirected_from) = @_;
927   
928    my $script_url = $self->config->script_url;
929    my $script_name = $self->config->script_name;
930    my $formatter = $self->wiki->formatter;
931
932    my $id = $formatter->node_name_to_node_param( $node );
933    my $oldid;
934    $oldid = $formatter->node_name_to_node_param( $redirected_from ) if $redirected_from;
935
936    my $redir_param = "$script_url$script_name?";
937    $redir_param .= 'id=' if $oldid;
938    $redir_param .= $id;
939    $redir_param .= ";oldid=$oldid" if $oldid;
940   
941    my $q = CGI->new;
942    return $q->redirect( $redir_param );
943}
944
945sub get_cookie {
946    my $self = shift;
947    my $config = $self->config;
948    my $pref_name = shift or return "";
949    my %cookie_data = OpenGuides::CGI->get_prefs_from_cookie(config=>$config);
950    return $cookie_data{$pref_name};
951}
952
953=back
954
955=head1 BUGS AND CAVEATS
956
957UTF8 data are currently not handled correctly throughout.
958
959Other bugs are documented at
960L<http://dev.openguides.org/>
961
962=head1 SEE ALSO
963
964=over 4
965
966=item * L<http://london.openguides.org/|The Open Guide to London>, the first and biggest OpenGuides site.
967
968=item * L<http://openguides.org/|The OpenGuides website>, with a list of all live OpenGuides installs.
969
970=item * L<CGI::Wiki>, the Wiki toolkit which does the heavy lifting for OpenGuides
971
972=back
973
974=head1 FEEDBACK
975
976If you have a question, a bug report, or a patch, or you're interested
977in joining the development team, please contact openguides-dev@openguides.org
978(moderated mailing list, will reach all current developers but you'll have
979to wait for your post to be approved) or file a bug report at
980L<http://dev.openguides.org/>
981
982=head1 AUTHOR
983
984The OpenGuides Project (openguides-dev@openguides.org)
985
986=head1 COPYRIGHT
987
988     Copyright (C) 2003-2006 The OpenGuides Project.  All Rights Reserved.
989
990The OpenGuides distribution is free software; you can redistribute it
991and/or modify it under the same terms as Perl itself.
992
993=head1 CREDITS
994
995Programming by Dominic Hargreaves, Earle Martin, Kake Pugh, and Ivor
996Williams.  Testing and bug reporting by Billy Abbott, Jody Belka,
997Kerry Bosworth, Simon Cozens, Cal Henderson, Steve Jolly, and Bob
998Walker (among others).  Much of the Module::Build stuff copied from
999the Siesta project L<http://siesta.unixbeard.net/>
1000
1001=cut
1002
10031;
Note: See TracBrowser for help on using the repository browser.