source: trunk/lib/OpenGuides.pm @ 559

Last change on this file since 559 was 559, checked in by kake, 17 years ago

Huge-ass pile of changes to make geo stuff work worldwide.

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