source: trunk/lib/OpenGuides.pm @ 687

Last change on this file since 687 was 687, checked in by Earle Martin, 16 years ago

new format=raw output option

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