source: trunk/lib/OpenGuides.pm @ 703

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

DOAP metadata for RSS feed from new CGI::Wiki::Plugin::RSS

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