source: trunk/lib/OpenGuides.pm @ 717

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

Sorry, I screwed up the last commit - tests pass now. This fixes bug #17.

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