root/tags/rel0_48/lib/OpenGuides.pm

Revision 661, 31.7 kB (checked in by dom, 3 years ago)

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