source: trunk/lib/OpenGuides.pm @ 700

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

Change "action=rss" parameter to "action=rc;format=rss". Extract RecentChanges code in OpenGuides.pm to its own sub (display_recent_changes()). Fix references to old params in templates. Put redirect to URL with new parameters into wiki.cgi for old parameter.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 34.1 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                                         );
666    my $output = "Content-Type: text/plain\n";
667    $output .= "Last-Modified: " . $rdf_writer->rss_timestamp( %criteria ) . "\n\n";
668    $output .= $rdf_writer->make_recentchanges_rss( %criteria );
669    return $output if $return_output;
670    print $output;
671}
672
673=item B<commit_node>
674
675  $guide->commit_node(
676                         id      => $node,
677                         cgi_obj => $q,
678                     );
679
680As with other methods, parameters C<return_tt_vars> and
681C<return_output> can be used to return these things instead of
682printing the output to STDOUT.
683
684The geographical data that you should provide in the L<CGI> object
685depends on the handler you chose in C<wiki.conf>.
686
687=over
688
689=item *
690
691B<British National Grid> - provide either C<os_x> and C<os_y> or
692C<latitude> and C<longitude>; whichever set of data you give, it will
693be converted to the other and both sets will be stored.
694
695=item *
696
697B<Irish National Grid> - provide either C<osie_x> and C<osie_y> or
698C<latitude> and C<longitude>; whichever set of data you give, it will
699be converted to the other and both sets will be stored.
700
701=item *
702
703B<UTM ellipsoid> - provide C<latitude> and C<longitude>; these will be
704converted to easting and northing and both sets of data will be stored.
705
706=back
707
708=cut
709
710sub commit_node {
711    my ($self, %args) = @_;
712    my $node = $args{id};
713    my $q = $args{cgi_obj};
714    my $return_output = $args{return_output};
715    my $wiki = $self->wiki;
716    my $config = $self->config;
717
718    my $content  = $q->param("content");
719    $content =~ s/\r\n/\n/gs;
720    my $checksum = $q->param("checksum");
721
722    my %metadata = OpenGuides::Template->extract_metadata_vars(
723        wiki    => $wiki,
724        config  => $config,
725    cgi_obj => $q
726    );
727
728    $metadata{opening_hours_text} = $q->param("hours_text") || "";
729
730    # Pick out the unmunged versions of lat/long if they're set.
731    # (If they're not, it means they weren't munged in the first place.)
732    $metadata{latitude} = delete $metadata{latitude_unmunged}
733        if $metadata{latitude_unmunged};
734    $metadata{longitude} = delete $metadata{longitude_unmunged}
735        if $metadata{longitude_unmunged};
736
737    # Check to make sure all the indexable nodes are created
738    foreach my $type (qw(Category Locale)) {
739        my $lctype = lc($type);
740        foreach my $index (@{$metadata{$lctype}}) {
741            $index =~ s/(.*)/\u$1/;
742            my $node = $type . " " . $index;
743            # Uppercase the node name before checking for existence
744            $node =~ s/ (\S+)/ \u$1/g;
745            unless ( $wiki->node_exists($node) ) {
746                my $category = $type eq "Category" ? "Category" : "Locales";
747                $wiki->write_node(
748                                     $node,
749                                     "\@INDEX_LINK [[$node]]",
750                                     undef,
751                                     {
752                                         username => "Auto Create",
753                                         comment  => "Auto created $lctype stub page",
754                                         category => $category
755                                     }
756                                 );
757            }
758        }
759    }
760   
761    foreach my $var ( qw( summary username comment edit_type ) ) {
762        $metadata{$var} = $q->param($var) || "";
763    }
764    $metadata{host} = $ENV{REMOTE_ADDR};
765
766    # CGI::Wiki::Plugin::RSS::ModWiki wants "major_change" to be set.
767    $metadata{major_change} = ( $metadata{edit_type} eq "Normal edit" )
768                            ? 1
769                            : 0;
770
771    my $written = $wiki->write_node($node, $content, $checksum, \%metadata );
772
773    if ($written) {
774        my $output = $self->redirect_to_node($node);
775        return $output if $return_output;
776        print $output;
777    } else {
778        my %node_data = $wiki->retrieve_node($node);
779        my %tt_vars = ( checksum       => $node_data{checksum},
780                        new_content    => $content,
781                        stored_content => $node_data{content} );
782        foreach my $mdvar ( keys %metadata ) {
783            if ($mdvar eq "locales") {
784                $tt_vars{"stored_$mdvar"} = $node_data{metadata}{locale};
785                $tt_vars{"new_$mdvar"}    = $metadata{locale};
786            } elsif ($mdvar eq "categories") {
787                $tt_vars{"stored_$mdvar"} = $node_data{metadata}{category};
788                $tt_vars{"new_$mdvar"}    = $metadata{category};
789            } elsif ($mdvar eq "username" or $mdvar eq "comment"
790                      or $mdvar eq "edit_type" ) {
791                $tt_vars{$mdvar} = $metadata{$mdvar};
792            } else {
793                $tt_vars{"stored_$mdvar"} = $node_data{metadata}{$mdvar}[0];
794                $tt_vars{"new_$mdvar"}    = $metadata{$mdvar};
795            }
796        }
797        return %tt_vars if $args{return_tt_vars};
798        my $output = $self->process_template(
799                                              id       => $node,
800                                              template => "edit_conflict.tt",
801                                              tt_vars  => \%tt_vars,
802                                            );
803        return $output if $args{return_output};
804        print $output;
805    }
806}
807
808
809=item B<delete_node>
810
811  $guide->delete_node(
812                         id       => "FAQ",
813                         version  => 15,
814                         password => "beer",
815                     );
816
817C<version> is optional - if it isn't supplied then all versions of the
818node will be deleted; in other words the node will be entirely
819removed.
820
821If C<password> is not supplied then a form for entering the password
822will be displayed.
823
824As with other methods, parameters C<return_tt_vars> and
825C<return_output> can be used to return these things instead of
826printing the output to STDOUT.
827
828=cut
829
830sub delete_node {
831    my ($self, %args) = @_;
832    my $node = $args{id} or croak "No node ID supplied for deletion";
833    my $return_tt_vars = $args{return_tt_vars} || 0;
834    my $return_output = $args{return_output} || 0;
835
836    my %tt_vars = (
837                      not_editable  => 1,
838                      not_deletable => 1,
839                      deter_robots  => 1,
840                  );
841    $tt_vars{delete_version} = $args{version} || "";
842
843    my $password = $args{password};
844
845    if ($password) {
846        if ($password ne $self->config->admin_pass) {
847            return %tt_vars if $return_tt_vars;
848            my $output = $self->process_template(
849                                                    id       => $node,
850                                                    template => "delete_password_wrong.tt",
851                                                    tt_vars  => \%tt_vars,
852                                                );
853            return $output if $return_output;
854            print $output;
855        } else {
856            $self->wiki->delete_node(
857                                        name    => $node,
858                                        version => $args{version},
859                                    );
860            # Check whether any versions of this node remain.
861            my %check = $self->wiki->retrieve_node( name => $node );
862            $tt_vars{other_versions_remain} = 1 if $check{version};
863            return %tt_vars if $return_tt_vars;
864            my $output = $self->process_template(
865                                                    id       => $node,
866                                                    template => "delete_done.tt",
867                                                    tt_vars  => \%tt_vars,
868                                                );
869            return $output if $return_output;
870            print $output;
871        }
872    } else {
873        return %tt_vars if $return_tt_vars;
874        my $output = $self->process_template(
875                                                id       => $node,
876                                                template => "delete_confirm.tt",
877                                                tt_vars  => \%tt_vars,
878                                            );
879        return $output if $return_output;
880        print $output;
881    }
882}
883
884sub process_template {
885    my ($self, %args) = @_;
886    my %output_conf = (
887                          wiki     => $self->wiki,
888                          config   => $self->config,
889                          node     => $args{id},
890                          template => $args{template},
891                          vars     => $args{tt_vars},
892                          cookies  => $args{cookies},
893                      );
894    if ( $args{content_type} ) {
895        $output_conf{content_type} = "";
896        my $output = "Content-Type: $args{content_type}\n\n"
897                     . OpenGuides::Template->output( %output_conf );
898    } else {
899        return OpenGuides::Template->output( %output_conf );
900    }
901}
902
903sub redirect_to_node {
904    my ($self, $node, $redirected_from) = @_;
905   
906    my $script_url = $self->config->script_url;
907    my $script_name = $self->config->script_name;
908    my $formatter = $self->wiki->formatter;
909
910    my $id = $formatter->node_name_to_node_param( $node );
911    my $oldid;
912    $oldid = $formatter->node_name_to_node_param( $redirected_from ) if $redirected_from;
913
914    my $redir_param = "$script_url$script_name?";
915    $redir_param .= 'id=' if $oldid;
916    $redir_param .= $id;
917    $redir_param .= ";oldid=$oldid" if $oldid;
918
919    return CGI->redirect( $redir_param );
920}
921
922sub get_cookie {
923    my $self = shift;
924    my $config = $self->config;
925    my $pref_name = shift or return "";
926    my %cookie_data = OpenGuides::CGI->get_prefs_from_cookie(config=>$config);
927    return $cookie_data{$pref_name};
928}
929
930
931=back
932
933=head1 BUGS AND CAVEATS
934
935UTF8 data are currently not handled correctly throughout.
936
937Other bugs are documented at
938L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=OpenGuides>
939
940=head1 SEE ALSO
941
942=over 4
943
944=item * L<http://london.openguides.org/|The Open Guide to London>, the first and biggest OpenGuides site.
945
946=item * L<http://openguides.org/|The OpenGuides website>, with a list of all live OpenGuides installs.
947
948=item * L<CGI::Wiki>, the Wiki toolkit which does the heavy lifting for OpenGuides
949
950=back
951
952=head1 FEEDBACK
953
954If you have a question, a bug report, or a patch, or you're interested
955in joining the development team, please contact openguides-dev@openguides.org
956(moderated mailing list, will reach all current developers but you'll have
957to wait for your post to be approved) or file a bug report at
958L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=OpenGuides>
959
960=head1 AUTHOR
961
962The OpenGuides Project (openguides-dev@openguides.org)
963
964=head1 COPYRIGHT
965
966     Copyright (C) 2003-2005 The OpenGuides Project.  All Rights Reserved.
967
968The OpenGuides distribution is free software; you can redistribute it
969and/or modify it under the same terms as Perl itself.
970
971=head1 CREDITS
972
973Programming by Dominic Hargreaves, Earle Martin, Kake Pugh, and Ivor
974Williams.  Testing and bug reporting by Billy Abbott, Jody Belka,
975Kerry Bosworth, Simon Cozens, Cal Henderson, Steve Jolly, and Bob
976Walker (among others).  Much of the Module::Build stuff copied from
977the Siesta project L<http://siesta.unixbeard.net/>
978
979=cut
980
9811;
Note: See TracBrowser for help on using the repository browser.