source: trunk/lib/OpenGuides.pm @ 646

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

copyright year update

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