source: trunk/lib/OpenGuides.pm @ 618

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

add signature file to manifest, and update for 0.47

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