source: trunk/lib/OpenGuides.pm @ 648

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

Fix redirection loops, RT #13205

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