source: trunk/lib/OpenGuides.pm @ 656

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

fix redirect checking

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