source: trunk/lib/OpenGuides.pm @ 683

Last change on this file since 683 was 683, checked in by Earle Martin, 16 years ago

new "summary" metadata field

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