source: trunk/lib/OpenGuides.pm @ 633

Last change on this file since 633 was 633, checked in by Earle Martin, 17 years ago

new format=plain option for node index listing

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 31.1 KB
Line 
1package OpenGuides;
2use strict;
3
4use Carp "croak";
5use CGI;
6use CGI::Wiki::Plugin::Diff;
7use CGI::Wiki::Plugin::Locator::Grid;
8use OpenGuides::CGI;
9use OpenGuides::Template;
10use OpenGuides::Utils;
11use Time::Piece;
12use URI::Escape;
13
14use vars qw( $VERSION );
15
16$VERSION = '0.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} )
488    {
489      if ( $args{format} eq "rdf" )
490      {
491        $template = "rdf_index.tt";
492        $conf{content_type} = "text/plain";
493      }
494      elsif ( $args{format} eq "plain" )
495      {
496        $template = "plain_index.tt";
497        $conf{content_type} = "text/plain";
498      }
499    }
500    else
501    {
502      $template = "site_index.tt";
503    }
504
505    %conf = (
506              %conf,
507              node        => "$args{type} index", # KLUDGE
508              template    => $template,
509              tt_vars     => \%tt_vars,
510    );
511
512    my $output = $self->process_template( %conf );
513    return $output if $args{return_output};
514    print $output;
515}
516
517=item B<list_all_versions>
518
519  $guide->list_all_versions ( id => "Home Page" );
520
521  # Or return output as a string (useful for writing tests).
522  $guide->list_all_versions (
523                              id            => "Home Page",
524                              return_output => 1,
525                            );
526
527  # Or return the hash of variables that will be passed to the template
528  # (not including those set additionally by OpenGuides::Template).
529  $guide->list_all_versions (
530                              id             => "Home Page",
531                              return_tt_vars => 1,
532                            );
533
534=cut
535
536sub list_all_versions {
537    my ($self, %args) = @_;
538    my $return_output = $args{return_output} || 0;
539    my $node = $args{id};
540    my %curr_data = $self->wiki->retrieve_node($node);
541    my $curr_version = $curr_data{version};
542    my @history;
543    for my $version ( 1 .. $curr_version ) {
544        my %node_data = $self->wiki->retrieve_node( name    => $node,
545                                                    version => $version );
546        # $node_data{version} will be zero if this version was deleted.
547        push @history, {
548            version  => CGI->escapeHTML( $version ),
549            modified => CGI->escapeHTML( $node_data{last_modified} ),
550            username => CGI->escapeHTML( $node_data{metadata}{username}[0] ),
551            comment  => CGI->escapeHTML( $node_data{metadata}{comment}[0] ),
552                       } if $node_data{version};
553    }
554    @history = reverse @history;
555    my %tt_vars = ( node          => $node,
556                    version       => $curr_version,
557                    not_deletable => 1,
558                    not_editable  => 1,
559                    deter_robots  => 1,
560                    history       => \@history );
561    return %tt_vars if $args{return_tt_vars};
562    my $output = $self->process_template(
563                                          id       => $node,
564                                          template => "node_history.tt",
565                                          tt_vars  => \%tt_vars,
566                                        );
567    return $output if $return_output;
568    print $output;
569}
570
571=item B<display_rss>
572
573  # Last ten non-minor edits to Hammersmith pages.
574  $guide->display_rss(
575                       items              => 10,
576                       ignore_minor_edits => 1,
577                       locale             => "Hammersmith",
578                     );
579
580  # All edits bob has made to pub pages in the last week.
581  $guide->display_rss(
582                       days     => 7,
583                       username => "bob",
584                       category => "Pubs",
585                     );
586
587As with other methods, the C<return_output> parameter can be used to
588return the output instead of printing it to STDOUT.
589
590=cut
591
592sub display_rss {
593    my ($self, %args) = @_;
594
595    my $return_output = $args{return_output} ? 1 : 0;
596
597    my $items = $args{items} || "";
598    my $days  = $args{days}  || "";
599    my $ignore_minor_edits = $args{ignore_minor_edits} ? 1 : 0;
600    my $username = $args{username} || "";
601    my $category = $args{category} || "";
602    my $locale   = $args{locale}   || "";
603    my %criteria = (
604                     items              => $items,
605                     days               => $days,
606                     ignore_minor_edits => $ignore_minor_edits,
607                   );
608    my %filter;
609    $filter{username} = $username if $username;
610    $filter{category} = $category if $category;
611    $filter{locale}   = $locale   if $locale;
612    if ( scalar keys %filter ) {
613        $criteria{filter_on_metadata} = \%filter;
614    }
615
616    my $rdf_writer = OpenGuides::RDF->new( wiki   => $self->wiki,
617                                           config => $self->config );
618    my $output = "Content-type: text/plain\n\n";
619    $output .= $rdf_writer->make_recentchanges_rss( %criteria );
620    return $output if $return_output;
621    print $output;
622}
623
624=item B<commit_node>
625
626  $guide->commit_node(
627                       id      => $node,
628                       cgi_obj => $q,
629                     );
630
631As with other methods, parameters C<return_tt_vars> and
632C<return_output> can be used to return these things instead of
633printing the output to STDOUT.
634
635The geographical data that you should provide in the L<CGI> object
636depends on the handler you chose in C<wiki.conf>.
637
638=over
639
640=item *
641
642B<British National Grid> - provide either C<os_x> and C<os_y> or
643C<latitude> and C<longitude>; whichever set of data you give, it will
644be converted to the other and both sets will be stored.
645
646=item *
647
648B<Irish National Grid> - provide either C<osie_x> and C<osie_y> or
649C<latitude> and C<longitude>; whichever set of data you give, it will
650be converted to the other and both sets will be stored.
651
652=item *
653
654B<UTM ellipsoid> - provide C<latitude> and C<longitude>; these will be
655converted to easting and northing and both sets of data will be stored.
656
657=back
658
659=cut
660
661sub commit_node {
662    my ($self, %args) = @_;
663    my $node = $args{id};
664    my $q = $args{cgi_obj};
665    my $return_output = $args{return_output};
666    my $wiki = $self->wiki;
667    my $config = $self->config;
668
669    my $content  = $q->param("content");
670    $content =~ s/\r\n/\n/gs;
671    my $checksum = $q->param("checksum");
672
673    my %metadata = OpenGuides::Template->extract_metadata_vars(
674        wiki    => $wiki,
675        config  => $config,
676        cgi_obj => $q
677    );
678
679    $metadata{opening_hours_text} = $q->param("hours_text") || "";
680
681    # Pick out the unmunged versions of lat/long if they're set.
682    # (If they're not, it means they weren't munged in the first place.)
683    $metadata{latitude} = delete $metadata{latitude_unmunged}
684        if $metadata{latitude_unmunged};
685    $metadata{longitude} = delete $metadata{longitude_unmunged}
686        if $metadata{longitude_unmunged};
687
688    # Check to make sure all the indexable nodes are created
689    foreach my $type (qw(Category Locale)) {
690        my $lctype = lc($type);
691        foreach my $index (@{$metadata{$lctype}}) {
692            $index =~ s/(.*)/\u$1/;
693            my $node = $type . " " . $index;
694            # Uppercase the node name before checking for existence
695            $node =~ s/ (\S+)/ \u$1/g;
696            unless ( $wiki->node_exists($node) ) {
697                my $category = $type eq "Category" ? "Category" : "Locales";
698                $wiki->write_node( $node,
699                                   "\@INDEX_LINK [[$node]]",
700                                   undef,
701                                   { username => "Auto Create",
702                                     comment  => "Auto created $lctype stub page",
703                                     category => $category
704                                   }
705                );
706            }
707        }
708    }
709       
710    foreach my $var ( qw( username comment edit_type ) ) {
711        $metadata{$var} = $q->param($var) || "";
712    }
713    $metadata{host} = $ENV{REMOTE_ADDR};
714
715    # CGI::Wiki::Plugin::RSS::ModWiki wants "major_change" to be set.
716    $metadata{major_change} = ( $metadata{edit_type} eq "Normal edit" )
717                            ? 1
718                            : 0;
719
720    my $written = $wiki->write_node($node, $content, $checksum, \%metadata );
721
722    if ($written) {
723        my $output = $self->redirect_to_node($node);
724        return $output if $return_output;
725        print $output;
726    } else {
727        my %node_data = $wiki->retrieve_node($node);
728        my %tt_vars = ( checksum       => $node_data{checksum},
729                        new_content    => $content,
730                        stored_content => $node_data{content} );
731        foreach my $mdvar ( keys %metadata ) {
732            if ($mdvar eq "locales") {
733                $tt_vars{"stored_$mdvar"} = $node_data{metadata}{locale};
734                $tt_vars{"new_$mdvar"}    = $metadata{locale};
735            } elsif ($mdvar eq "categories") {
736                $tt_vars{"stored_$mdvar"} = $node_data{metadata}{category};
737                $tt_vars{"new_$mdvar"}    = $metadata{category};
738            } elsif ($mdvar eq "username" or $mdvar eq "comment"
739                      or $mdvar eq "edit_type" ) {
740                $tt_vars{$mdvar} = $metadata{$mdvar};
741            } else {
742                $tt_vars{"stored_$mdvar"} = $node_data{metadata}{$mdvar}[0];
743                $tt_vars{"new_$mdvar"}    = $metadata{$mdvar};
744            }
745        }
746        return %tt_vars if $args{return_tt_vars};
747        my $output = $self->process_template(
748                                              id       => $node,
749                                              template => "edit_conflict.tt",
750                                              tt_vars  => \%tt_vars,
751                                            );
752        return $output if $args{return_output};
753        print $output;
754    }
755}
756
757
758=item B<delete_node>
759
760  $guide->delete_node(
761                       id       => "FAQ",
762                       version  => 15,
763                       password => "beer",
764                     );
765
766C<version> is optional - if it isn't supplied then all versions of the
767node will be deleted; in other words the node will be entirely
768removed.
769
770If C<password> is not supplied then a form for entering the password
771will be displayed.
772
773As with other methods, parameters C<return_tt_vars> and
774C<return_output> can be used to return these things instead of
775printing the output to STDOUT.
776
777=cut
778
779sub delete_node {
780    my ($self, %args) = @_;
781    my $node = $args{id} or croak "No node ID supplied for deletion";
782    my $return_tt_vars = $args{return_tt_vars} || 0;
783    my $return_output = $args{return_output} || 0;
784
785    my %tt_vars = (
786                    not_editable  => 1,
787                    not_deletable => 1,
788                    deter_robots  => 1,
789                  );
790    $tt_vars{delete_version} = $args{version} || "";
791
792    my $password = $args{password};
793
794    if ($password) {
795        if ($password ne $self->config->admin_pass) {
796            return %tt_vars if $return_tt_vars;
797            my $output = $self->process_template(
798                                     id       => $node,
799                                     template => "delete_password_wrong.tt",
800                                     tt_vars  => \%tt_vars,
801                                   );
802            return $output if $return_output;
803            print $output;
804        } else {
805            $self->wiki->delete_node(
806                                      name    => $node,
807                                      version => $args{version},
808                                    );
809            # Check whether any versions of this node remain.
810            my %check = $self->wiki->retrieve_node( name => $node );
811            $tt_vars{other_versions_remain} = 1 if $check{version};
812            return %tt_vars if $return_tt_vars;
813            my $output = $self->process_template(
814                                     id       => $node,
815                                     template => "delete_done.tt",
816                                     tt_vars  => \%tt_vars,
817                                   );
818            return $output if $return_output;
819            print $output;
820        }
821    } else {
822        return %tt_vars if $return_tt_vars;
823        my $output = $self->process_template(
824                                 id       => $node,
825                                 template => "delete_confirm.tt",
826                                 tt_vars  => \%tt_vars,
827                               );
828        return $output if $return_output;
829        print $output;
830    }
831}
832
833sub process_template {
834    my ($self, %args) = @_;
835    my %output_conf = ( wiki     => $self->wiki,
836                        config   => $self->config,
837                        node     => $args{id},
838                        template => $args{template},
839                        vars     => $args{tt_vars},
840                        cookies  => $args{cookies},
841    );
842    if ( $args{content_type} ) {
843        $output_conf{content_type} = "";
844        my $output = "Content-Type: $args{content_type}\n\n"
845                     . OpenGuides::Template->output( %output_conf );
846    } else {
847        return OpenGuides::Template->output( %output_conf );
848    }
849}
850
851sub redirect_to_node {
852    my ($self, $node) = @_;
853    my $script_url = $self->config->script_url;
854    my $script_name = $self->config->script_name;
855    my $formatter = $self->wiki->formatter;
856    my $param = $formatter->node_name_to_node_param( $node );
857    return CGI->redirect( "$script_url$script_name?$param" );
858}
859
860sub get_cookie {
861    my $self = shift;
862    my $config = $self->config;
863    my $pref_name = shift or return "";
864    my %cookie_data = OpenGuides::CGI->get_prefs_from_cookie(config=>$config);
865    return $cookie_data{$pref_name};
866}
867
868
869=back
870
871=head1 BUGS AND CAVEATS
872
873UTF8 data are currently not handled correctly throughout.
874
875Other bugs are documented at
876L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=OpenGuides>
877
878=head1 SEE ALSO
879
880=over 4
881
882=item * L<http://london.openguides.org/|The Open Guide to London>, the first and biggest OpenGuides site.
883
884=item * L<http://openguides.org/|The OpenGuides website>, with a list of all live OpenGuides installs.
885
886=item * L<CGI::Wiki>, the Wiki toolkit which does the heavy lifting for OpenGuides
887
888=back
889
890=head1 FEEDBACK
891
892If you have a question, a bug report, or a patch, or you're interested
893in joining the development team, please contact openguides-dev@openguides.org
894(moderated mailing list, will reach all current developers but you'll have
895to wait for your post to be approved) or file a bug report at
896L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=OpenGuides>
897
898=head1 AUTHOR
899
900The OpenGuides Project (openguides-dev@openguides.org)
901
902=head1 COPYRIGHT
903
904     Copyright (C) 2003-2004 The OpenGuides Project.  All Rights Reserved.
905
906The OpenGuides distribution is free software; you can redistribute it
907and/or modify it under the same terms as Perl itself.
908
909=head1 CREDITS
910
911Programming by Dominic Hargreaves, Earle Martin, Kake Pugh, and Ivor
912Williams.  Testing and bug reporting by Billy Abbott, Jody Belka,
913Kerry Bosworth, Simon Cozens, Cal Henderson, Steve Jolly, and Bob
914Walker (among others).  Much of the Module::Build stuff copied from
915the Siesta project L<http://siesta.unixbeard.net/>
916
917=cut
918
9191;
Note: See TracBrowser for help on using the repository browser.