source: trunk/lib/OpenGuides.pm @ 602

Last change on this file since 602 was 602, checked in by kake, 17 years ago

Fixed a couple of bugs to do with nodes with only one version - list_all_versions, diff link.

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