source: trunk/lib/OpenGuides.pm @ 587

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

Encapsulate config data in OpenGuides::Config.

  • 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.45';
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    croak "This is the first version" unless $curr_version > 1;
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
862At the moment, the location data uses a United-Kingdom-specific module,
863so the location features might not work so well outside the UK.
864
865=head1 SEE ALSO
866
867=over 4
868
869=item * L<http://london.openguides.org/|The Open Guide to London>, the first and biggest OpenGuides site.
870
871=item * L<http://openguides.org/|The OpenGuides website>, with a list of all live OpenGuides installs.
872
873=item * L<CGI::Wiki>, the Wiki toolkit which does the heavy lifting for OpenGuides
874
875=back
876
877=head1 FEEDBACK
878
879If you have a question, a bug report, or a patch, or you're interested
880in joining the development team, please contact openguides-dev@openguides.org
881(moderated mailing list, will reach all current developers but you'll have
882to wait for your post to be approved) or kake@earth.li (a real person who
883may take a little while to reply to your mail if she's busy).
884
885=head1 AUTHOR
886
887The OpenGuides Project (openguides-dev@openguides.org)
888
889=head1 COPYRIGHT
890
891     Copyright (C) 2003-2004 The OpenGuides Project.  All Rights Reserved.
892
893The OpenGuides distribution is free software; you can redistribute it
894and/or modify it under the same terms as Perl itself.
895
896=head1 CREDITS
897
898Programming by Dominic Hargreaves, Earle Martin, Kake Pugh, and Ivor
899Williams.  Testing and bug reporting by Billy Abbott, Jody Belka,
900Kerry Bosworth, Simon Cozens, Cal Henderson, Steve Jolly, and Bob
901Walker (among others).  Much of the Module::Build stuff copied from
902the Siesta project L<http://siesta.unixbeard.net/>
903
904=cut
905
9061;
Note: See TracBrowser for help on using the repository browser.