source: trunk/lib/OpenGuides.pm @ 867

Last change on this file since 867 was 867, checked in by Dominic Hargreaves, 15 years ago

&/& -> ;

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 56.4 KB
Line 
1package OpenGuides;
2use strict;
3
4use Carp "croak";
5use CGI;
6use Wiki::Toolkit::Plugin::Diff;
7use Wiki::Toolkit::Plugin::Locator::Grid;
8use OpenGuides::CGI;
9use OpenGuides::Feed;
10use OpenGuides::Template;
11use OpenGuides::Utils;
12use Time::Piece;
13use URI::Escape;
14
15use vars qw( $VERSION );
16
17$VERSION = '0.57';
18
19=head1 NAME
20
21OpenGuides - A complete web application for managing a collaboratively-written guide to a city or town.
22
23=head1 DESCRIPTION
24
25The OpenGuides software provides the framework for a collaboratively-written
26city guide.  It is similar to a wiki but provides somewhat more structured
27data storage allowing you to annotate wiki pages with information such as
28category, location, and much more.  It provides searching facilities
29including "find me everything within a certain distance of this place".
30Every page includes a link to a machine-readable (RDF) version of the page.
31
32=head1 METHODS
33
34=over
35
36=item B<new>
37
38  my $config = OpenGuides::Config->new( file => "wiki.conf" );
39  my $guide = OpenGuides->new( config => $config );
40
41=cut
42
43sub new {
44    my ($class, %args) = @_;
45    my $self = {};
46    bless $self, $class;
47    my $wiki = OpenGuides::Utils->make_wiki_object( config => $args{config} );
48    $self->{wiki} = $wiki;
49    $self->{config} = $args{config};
50    my $geo_handler = $self->config->geo_handler;
51    my $locator;
52    if ( $geo_handler == 1 ) {
53        $locator = Wiki::Toolkit::Plugin::Locator::Grid->new(
54                                             x => "os_x",    y => "os_y" );
55    } elsif ( $geo_handler == 2 ) {
56        $locator = Wiki::Toolkit::Plugin::Locator::Grid->new(
57                                             x => "osie_x",  y => "osie_y" );
58    } else {
59        $locator = Wiki::Toolkit::Plugin::Locator::Grid->new(
60                                             x => "easting", y => "northing" );
61    }
62    $wiki->register_plugin( plugin => $locator );
63    $self->{locator} = $locator;
64    my $differ = Wiki::Toolkit::Plugin::Diff->new;
65    $wiki->register_plugin( plugin => $differ );
66    $self->{differ} = $differ;
67    return $self;
68}
69
70=item B<wiki>
71
72An accessor, returns the underlying L<Wiki::Toolkit> object.
73
74=cut
75
76sub wiki {
77    my $self = shift;
78    return $self->{wiki};
79}
80
81=item B<config>
82
83An accessor, returns the underlying L<OpenGuides::Config> object.
84
85=cut
86
87sub config {
88    my $self = shift;
89    return $self->{config};
90}
91
92=item B<locator>
93
94An accessor, returns the underlying L<Wiki::Toolkit::Plugin::Locator::UK> object.
95
96=cut
97
98sub locator {
99    my $self = shift;
100    return $self->{locator};
101}
102
103=item B<differ>
104
105An accessor, returns the underlying L<Wiki::Toolkit::Plugin::Diff> object.
106
107=cut
108
109sub differ {
110    my $self = shift;
111    return $self->{differ};
112}
113
114=item B<display_node>
115
116  # Print node to STDOUT.
117  $guide->display_node(
118                          id      => "Calthorpe Arms",
119                          version => 2,
120                      );
121
122  # Or return output as a string (useful for writing tests).
123  $guide->display_node(
124                          id            => "Calthorpe Arms",
125                          return_output => 1,
126                      );
127
128  # Or return the hash of variables that will be passed to the template
129  # (not including those set additionally by OpenGuides::Template).
130  $guide->display_node(
131                          id             => "Calthorpe Arms",
132                          return_tt_vars => 1,
133                      );
134
135If C<version> is omitted then the latest version will be displayed.
136
137=cut
138
139sub display_node {
140    my ($self, %args) = @_;
141    my $return_output = $args{return_output} || 0;
142    my $version = $args{version};
143    my $id = $args{id} || $self->config->home_name;
144    my $wiki = $self->wiki;
145    my $config = $self->config;
146    my $oldid = $args{oldid} || '';
147    my $do_redirect = $args{redirect} || 1;
148
149    my %tt_vars;
150
151    if ( $id =~ /^(Category|Locale) (.*)$/ ) {
152        my $type = $1;
153        $tt_vars{is_indexable_node} = 1;
154        $tt_vars{index_type} = lc($type);
155        $tt_vars{index_value} = $2;
156        $tt_vars{"rss_".lc($type)."_url"} =
157                           $config->script_name . "?action=rc;format=rss;"
158                           . lc($type) . "=" . lc(CGI->escape($2));
159        $tt_vars{"atom_".lc($type)."_url"} =
160                           $config->script_name . "?action=rc;format=atom;"
161                           . lc($type) . "=" . lc(CGI->escape($2));
162    }
163
164    my %current_data = $wiki->retrieve_node( $id );
165    my $current_version = $current_data{version};
166    undef $version if ($version && $version == $current_version);
167    my %criteria = ( name => $id );
168    $criteria{version} = $version if $version; # retrieve_node default is current
169
170    my %node_data = $wiki->retrieve_node( %criteria );
171
172    # Fixes passing undefined values to Text::Wikiformat if node doesn't exist.
173    my $raw        = $node_data{content} || " ";
174    my $content    = $wiki->format($raw);
175    my $modified   = $node_data{last_modified};
176    my $moderated  = $node_data{moderated};
177    my %metadata   = %{$node_data{metadata}};
178
179    my ($wgs84_long, $wgs84_lat) = OpenGuides::Utils->get_wgs84_coords(
180                                        longitude => $metadata{longitude}[0],
181                                        latitude => $metadata{latitude}[0],
182                                        config => $config);
183    if ($args{format} && $args{format} eq 'raw') {
184      print "Content-Type: text/plain\n\n";
185      print $raw;
186      return 0;
187    }
188   
189    my %metadata_vars = OpenGuides::Template->extract_metadata_vars(
190                            wiki     => $wiki,
191                            config   => $config,
192                            metadata => $node_data{metadata}
193                        );
194
195    %tt_vars = (
196                   %tt_vars,
197                   %metadata_vars,
198                   content       => $content,
199                   last_modified => $modified,
200                   version       => $node_data{version},
201                   node          => $id,
202                   language      => $config->default_language,
203                   moderated     => $moderated,
204                   oldid         => $oldid,
205                   enable_gmaps  => 1,
206                   display_google_maps => $self->get_cookie("display_google_maps"),
207                   wgs84_long    => $wgs84_long,
208                   wgs84_lat     => $wgs84_lat
209               );
210
211    # Should we include a standard list of categories or locales?
212    if ($config->enable_common_categories || $config->enable_common_locales) {
213        $tt_vars{common_catloc} = 1;
214        $tt_vars{common_categories} = $config->enable_common_categories;
215        $tt_vars{common_locales} = $config->enable_common_locales;
216        $tt_vars{catloc_link} = $config->script_name . "?id=";
217    }
218
219    if ( $raw =~ /^#REDIRECT\s+(.+?)\s*$/ ) {
220        my $redirect = $1;
221        # Strip off enclosing [[ ]] in case this is an extended link.
222        $redirect =~ s/^\[\[//;
223        $redirect =~ s/\]\]\s*$//;
224
225        # Don't redirect if the parameter "redirect" is given as 0.
226        if ($do_redirect == 0) {
227            return %tt_vars if $args{return_tt_vars};
228            $tt_vars{current} = 1;
229            my $output = $self->process_template(
230                                                  id            => $id,
231                                                  template      => "node.tt",
232                                                  tt_vars       => \%tt_vars,
233                                                );
234            return $output if $return_output;
235            print $output;
236        } elsif ( $wiki->node_exists($redirect) && $redirect ne $id && $redirect ne $oldid ) {
237            # Avoid loops by not generating redirects to the same node or the previous node.
238            my $output = $self->redirect_to_node($redirect, $id);
239            return $output if $return_output;
240            print $output;
241            return 0;
242        }
243    }
244
245    # We've undef'ed $version above if this is the current version.
246    $tt_vars{current} = 1 unless $version;
247
248    if ($id eq "RecentChanges") {
249        $self->display_recent_changes(%args);
250    } elsif ( $id eq $self->config->home_name ) {
251        my @recent = $wiki->list_recent_changes(
252            last_n_changes => 10,
253            metadata_was   => { edit_type => "Normal edit" },
254        );
255        @recent = map {
256                          {
257                              name          => CGI->escapeHTML($_->{name}),
258                              last_modified => CGI->escapeHTML($_->{last_modified}),
259                              version       => CGI->escapeHTML($_->{version}),
260                              comment       => CGI->escapeHTML($_->{metadata}{comment}[0]),
261                              username      => CGI->escapeHTML($_->{metadata}{username}[0]),
262                              url           => $config->script_name . "?"
263                                               . CGI->escape($wiki->formatter->node_name_to_node_param($_->{name}))
264                          }
265                      } @recent;
266        $tt_vars{recent_changes} = \@recent;
267        return %tt_vars if $args{return_tt_vars};
268        my $output = $self->process_template(
269                                                id            => $id,
270                                                template      => "home_node.tt",
271                                                tt_vars       => \%tt_vars,
272                                            );
273        return $output if $return_output;
274        print $output;
275    } else {
276        return %tt_vars if $args{return_tt_vars};
277        my $output = $self->process_template(
278                                                id            => $id,
279                                                template      => "node.tt",
280                                                tt_vars       => \%tt_vars,
281                                            );
282        return $output if $return_output;
283        print $output;
284    }
285}
286
287=item B<display_recent_changes> 
288
289  $guide->display_recent_changes;
290
291As with other methods, the C<return_output> parameter can be used to
292return the output instead of printing it to STDOUT.
293
294=cut
295
296sub display_recent_changes {
297    my ($self, %args) = @_;
298    my $config = $self->config;
299    my $wiki = $self->wiki;
300    my $minor_edits = $self->get_cookie( "show_minor_edits_in_rc" );
301    my $id = $args{id} || $self->config->home_name;
302    my $return_output = $args{return_output} || 0;
303    my (%tt_vars, %recent_changes);
304    my $q = CGI->new;
305    my $since = $q->param("since");
306    if ( $since ) {
307        $tt_vars{since} = $since;
308        my $t = localtime($since); # overloaded by Time::Piece
309        $tt_vars{since_string} = $t->strftime;
310        my %criteria = ( since => $since );   
311        $criteria{metadata_was} = { edit_type => "Normal edit" }
312          unless $minor_edits;
313        my @rc = $self->{wiki}->list_recent_changes( %criteria );
314 
315        @rc = map {
316            {
317              name        => CGI->escapeHTML($_->{name}),
318              last_modified => CGI->escapeHTML($_->{last_modified}),
319              version     => CGI->escapeHTML($_->{version}),
320              comment     => CGI->escapeHTML($_->{metadata}{comment}[0]),
321              username    => CGI->escapeHTML($_->{metadata}{username}[0]),
322              host        => CGI->escapeHTML($_->{metadata}{host}[0]),
323              username_param => CGI->escape($_->{metadata}{username}[0]),
324              edit_type   => CGI->escapeHTML($_->{metadata}{edit_type}[0]),
325              url         => $config->script_name . "?"
326      . CGI->escape($wiki->formatter->node_name_to_node_param($_->{name})),
327        }
328                   } @rc;
329        if ( scalar @rc ) {
330            $recent_changes{since} = \@rc; 
331        }
332    } else {
333        for my $days ( [0, 1], [1, 7], [7, 14], [14, 30] ) {
334            my %criteria = ( between_days => $days );
335            $criteria{metadata_was} = { edit_type => "Normal edit" }
336              unless $minor_edits;
337            my @rc = $self->{wiki}->list_recent_changes( %criteria );
338
339            @rc = map {
340            {
341              name        => CGI->escapeHTML($_->{name}),
342              last_modified => CGI->escapeHTML($_->{last_modified}),
343              version     => CGI->escapeHTML($_->{version}),
344              comment     => CGI->escapeHTML($_->{metadata}{comment}[0]),
345              username    => CGI->escapeHTML($_->{metadata}{username}[0]),
346              host        => CGI->escapeHTML($_->{metadata}{host}[0]),
347              username_param => CGI->escape($_->{metadata}{username}[0]),
348              edit_type   => CGI->escapeHTML($_->{metadata}{edit_type}[0]),
349              url         => $config->script_name . "?"
350      . CGI->escape($wiki->formatter->node_name_to_node_param($_->{name})),
351        }
352                       } @rc;
353            if ( scalar @rc ) {
354                $recent_changes{$days->[1]} = \@rc;
355        }
356        }
357    }
358    $tt_vars{not_editable} = 1;
359    $tt_vars{recent_changes} = \%recent_changes;
360    my %processing_args = (
361                            id            => $id,
362                            template      => "recent_changes.tt",
363                            tt_vars       => \%tt_vars,
364                           );
365    if ( !$since && $self->get_cookie("track_recent_changes_views") ) {
366    my $cookie =
367           OpenGuides::CGI->make_recent_changes_cookie(config => $config );
368        $processing_args{cookies} = $cookie;
369        $tt_vars{last_viewed} = OpenGuides::CGI->get_last_recent_changes_visit_from_cookie( config => $config );
370    }
371    return %tt_vars if $args{return_tt_vars};
372    my $output = $self->process_template( %processing_args );
373    return $output if $return_output;
374    print $output;
375}
376
377=item B<display_diffs>
378
379  $guide->display_diffs(
380                           id            => "Home Page",
381                           version       => 6,
382                           other_version => 5,
383                       );
384
385  # Or return output as a string (useful for writing tests).
386  my $output = $guide->display_diffs(
387                                        id            => "Home Page",
388                                        version       => 6,
389                                        other_version => 5,
390                                        return_output => 1,
391                                    );
392
393  # Or return the hash of variables that will be passed to the template
394  # (not including those set additionally by OpenGuides::Template).
395  my %vars = $guide->display_diffs(
396                                      id             => "Home Page",
397                                      version        => 6,
398                                      other_version  => 5,
399                                      return_tt_vars => 1,
400                                  );
401
402=cut
403
404sub display_diffs {
405    my ($self, %args) = @_;
406    my %diff_vars = $self->differ->differences(
407                                                  node          => $args{id},
408                                                  left_version  => $args{version},
409                                                  right_version => $args{other_version},
410                                              );
411    $diff_vars{not_deletable} = 1;
412    $diff_vars{not_editable}  = 1;
413    $diff_vars{deter_robots}  = 1;
414    return %diff_vars if $args{return_tt_vars};
415    my $output = $self->process_template(
416                                            id       => $args{id},
417                                            template => "differences.tt",
418                                            tt_vars  => \%diff_vars
419                                        );
420    return $output if $args{return_output};
421    print $output;
422}
423
424=item B<find_within_distance>
425
426  $guide->find_within_distance(
427                                  id => $node,
428                                  metres => $q->param("distance_in_metres")
429                              );
430
431=cut
432
433sub find_within_distance {
434    my ($self, %args) = @_;
435    my $node = $args{id};
436    my $metres = $args{metres};
437    my %data = $self->wiki->retrieve_node( $node );
438    my $lat = $data{metadata}{latitude}[0];
439    my $long = $data{metadata}{longitude}[0];
440    my $script_url = $self->config->script_url;
441    my $q = CGI->new;
442    print $q->redirect( $script_url . "search.cgi?lat=$lat;long=$long;distance_in_metres=$metres" );
443}
444
445=item B<show_backlinks>
446
447  $guide->show_backlinks( id => "Calthorpe Arms" );
448
449As with other methods, parameters C<return_tt_vars> and
450C<return_output> can be used to return these things instead of
451printing the output to STDOUT.
452
453=cut
454
455sub show_backlinks {
456    my ($self, %args) = @_;
457    my $wiki = $self->wiki;
458    my $formatter = $wiki->formatter;
459
460    my @backlinks = $wiki->list_backlinks( node => $args{id} );
461    my @results = map {
462                          {
463                              url   => CGI->escape($formatter->node_name_to_node_param($_)),
464                              title => CGI->escapeHTML($_)
465                          }
466                      } sort @backlinks;
467    my %tt_vars = ( results       => \@results,
468                    num_results   => scalar @results,
469                    not_deletable => 1,
470                    deter_robots  => 1,
471                    not_editable  => 1 );
472    return %tt_vars if $args{return_tt_vars};
473    my $output = OpenGuides::Template->output(
474                                                 node    => $args{id},
475                                                 wiki    => $wiki,
476                                                 config  => $self->config,
477                                                 template=>"backlink_results.tt",
478                                                 vars    => \%tt_vars,
479                                             );
480    return $output if $args{return_output};
481    print $output;
482}
483
484=item B<show_index>
485
486  $guide->show_index(
487                        type   => "category",
488                        value  => "pubs",
489                    );
490
491  # RDF version.
492  $guide->show_index(
493                        type   => "locale",
494                        value  => "Holborn",
495                        format => "rdf",
496                    );
497
498  # RSS / Atom version (recent changes style).
499  $guide->show_index(
500                        type   => "locale",
501                        value  => "Holborn",
502                        format => "rss",
503                    );
504
505  # Or return output as a string (useful for writing tests).
506  $guide->show_index(
507                        type          => "category",
508                        value         => "pubs",
509                        return_output => 1,
510                    );
511
512=cut
513
514sub show_index {
515    my ($self, %args) = @_;
516    my $wiki = $self->wiki;
517    my $formatter = $wiki->formatter;
518    my %tt_vars;
519    my @selnodes;
520
521    if ( $args{type} and $args{value} ) {
522        if ( $args{type} eq "fuzzy_title_match" ) {
523            my %finds = $wiki->fuzzy_title_match( $args{value} );
524            @selnodes = sort { $finds{$a} <=> $finds{$b} } keys %finds;
525            $tt_vars{criterion} = {
526                type  => $args{type},  # for RDF version
527                value => $args{value}, # for RDF version
528                name  => CGI->escapeHTML("Fuzzy Title Match on '$args{value}'")
529            };
530            $tt_vars{not_editable} = 1;
531        } else {
532            @selnodes = $wiki->list_nodes_by_metadata(
533                metadata_type  => $args{type},
534                metadata_value => $args{value},
535                ignore_case    => 1
536            );
537            my $name = ucfirst($args{type}) . " $args{value}";
538            my $url = $self->config->script_name
539                      . "?"
540                      . ucfirst( $args{type} )
541                      . "_"
542                      . uri_escape(
543                                      $formatter->node_name_to_node_param($args{value})
544                                  );
545            $tt_vars{criterion} = {
546                type  => $args{type},
547                value => $args{value}, # for RDF version
548                name  => CGI->escapeHTML( $name ),
549                url   => $url
550            };
551            $tt_vars{not_editable} = 1;
552        }
553    } else {
554        @selnodes = $wiki->list_all_nodes();
555    }
556
557    my @nodes = map {
558                        {
559                            name      => $_,
560                            node_data => { $wiki->retrieve_node( name => $_ ) },
561                            param     => $formatter->node_name_to_node_param($_) }
562                        } sort @selnodes;
563
564    $tt_vars{nodes} = \@nodes;
565
566    my ($template, %conf);
567
568    if ( $args{format} ) {
569        if ( $args{format} eq "rdf" ) {
570            $template = "rdf_index.tt";
571            $conf{content_type} = "application/rdf+xml";
572        }
573        elsif ( $args{format} eq "plain" ) {
574            $template = "plain_index.tt";
575            $conf{content_type} = "text/plain";
576        } elsif ( $args{format} eq "map" ) {
577            my $q = CGI->new;
578            $tt_vars{zoom} = $q->param('zoom') || '';
579            $tt_vars{lat} = $q->param('lat') || '';
580            $tt_vars{long} = $q->param('long') || '';
581            $tt_vars{centre_long} = $self->config->centre_long;
582            $tt_vars{centre_lat} = $self->config->centre_lat;
583            $tt_vars{default_gmaps_zoom} = $self->config->default_gmaps_zoom;
584            $tt_vars{enable_gmaps} = 1;
585            $tt_vars{display_google_maps} = 1; # override for this page
586            $template = "map_index.tt";
587           
588        } elsif( $args{format} eq "rss" || $args{format} eq "atom") {
589            # They really wanted a recent changes style rss/atom feed
590            my $feed_type = $args{format};
591            my ($feed,$content_type) = $self->get_feed_and_content_type($feed_type);
592            $feed->set_feed_name_and_url_params(
593                        "Index of $args{type} $args{value}",
594                        "action=index;index_type=$args{type};index_value=$args{value}"
595            );
596
597            # Grab the actual node data out of @nodes
598            my @node_data;
599            foreach my $node (@nodes) {
600                $node->{node_data}->{name} = $node->{name};
601                push @node_data, $node->{node_data};
602            }
603
604            my $output = "Content-Type: ".$content_type."\n";
605            $output .= $feed->build_feed_for_nodes($feed_type, @node_data);
606
607            return $output if $args{return_output};
608            print $output;
609            return;
610        }
611    } else {
612        $template = "site_index.tt";
613    }
614
615    %conf = (
616                %conf,
617                node        => "$args{type} index", # KLUDGE
618                template    => $template,
619                tt_vars     => \%tt_vars,
620            );
621
622    my $output = $self->process_template( %conf );
623    return $output if $args{return_output};
624    print $output;
625}
626
627=item B<list_all_versions>
628
629  $guide->list_all_versions ( id => "Home Page" );
630
631  # Or return output as a string (useful for writing tests).
632  $guide->list_all_versions (
633                                id            => "Home Page",
634                                return_output => 1,
635                            );
636
637  # Or return the hash of variables that will be passed to the template
638  # (not including those set additionally by OpenGuides::Template).
639  $guide->list_all_versions (
640                                id             => "Home Page",
641                                return_tt_vars => 1,
642                            );
643
644=cut
645
646sub list_all_versions {
647    my ($self, %args) = @_;
648    my $return_output = $args{return_output} || 0;
649    my $node = $args{id};
650    my %curr_data = $self->wiki->retrieve_node($node);
651    my $curr_version = $curr_data{version};
652    my @history;
653    for my $version ( 1 .. $curr_version ) {
654        my %node_data = $self->wiki->retrieve_node( name    => $node,
655                                                    version => $version );
656        # $node_data{version} will be zero if this version was deleted.
657        push @history, {
658            version  => CGI->escapeHTML( $version ),
659            modified => CGI->escapeHTML( $node_data{last_modified} ),
660            username => CGI->escapeHTML( $node_data{metadata}{username}[0] ),
661            comment  => CGI->escapeHTML( $node_data{metadata}{comment}[0] ),
662                       } if $node_data{version};
663    }
664    @history = reverse @history;
665    my %tt_vars = (
666                      node          => $node,
667                      version       => $curr_version,
668                      not_deletable => 1,
669                      not_editable  => 1,
670                      deter_robots  => 1,
671                      history       => \@history
672                  );
673    return %tt_vars if $args{return_tt_vars};
674    my $output = $self->process_template(
675                                            id       => $node,
676                                            template => "node_history.tt",
677                                            tt_vars  => \%tt_vars,
678                                        );
679    return $output if $return_output;
680    print $output;
681}
682
683=item B<get_feed_and_content_type>
684
685Fetch the OpenGuides feed object, and the output content type, for the
686supplied feed type.
687
688Handles all the setup for the OpenGuides feed object.
689=cut
690sub get_feed_and_content_type {
691    my ($self, $feed_type) = @_;
692
693    my $feed = OpenGuides::Feed->new(
694                                        wiki       => $self->wiki,
695                                        config     => $self->config,
696                                        og_version => $VERSION,
697                                    );
698
699    my $content_type = $feed->default_content_type($feed_type);
700
701    return ($feed, $content_type);
702}
703
704=item B<display_feed>
705
706  # Last ten non-minor edits to Hammersmith pages in RSS 1.0 format
707  $guide->display_feed(
708                         feed_type          => 'rss',
709                         feed_listing       => 'recent_changes',
710                         items              => 10,
711                         ignore_minor_edits => 1,
712                         locale             => "Hammersmith",
713                     );
714
715  # All edits bob has made to pub pages in the last week in Atom format
716  $guide->display_feed(
717                         feed_type    => 'atom',
718                         feed_listing => 'recent_changes',
719                         days         => 7,
720                         username     => "bob",
721                         category     => "Pubs",
722                     );
723
724C<feed_type> is a mandatory parameter. Supported values at present are
725"rss" and "atom".
726
727C<feed_listing> is a mandatory parameter. Supported values at present
728are "recent_changes". (More values are coming soon though!)
729
730As with other methods, the C<return_output> parameter can be used to
731return the output instead of printing it to STDOUT.
732
733=cut
734
735sub display_feed {
736    my ($self, %args) = @_;
737
738    my $feed_type = $args{feed_type};
739    croak "No feed type given" unless $feed_type;
740
741    my $feed_listing = $args{feed_listing};
742    croak "No feed listing given" unless $feed_listing;
743   
744    my $return_output = $args{return_output} ? 1 : 0;
745
746    # Basic criteria, whatever the feed listing type is
747    my %criteria = (
748                       feed_type             => $feed_type,
749                       feed_listing          => $feed_listing,
750                       also_return_timestamp => 1,
751                   );
752
753    # Feed listing specific criteria
754    if($feed_listing eq "recent_changes") {
755        $criteria{items} = $args{items} || "";
756        $criteria{days}  = $args{days}  || "";
757        $criteria{ignore_minor_edits} = $args{ignore_minor_edits} ? 1 : 0;
758
759        my $username = $args{username} || "";
760        my $category = $args{category} || "";
761        my $locale   = $args{locale}   || "";
762
763        my %filter;
764        $filter{username} = $username if $username;
765        $filter{category} = $category if $category;
766        $filter{locale}   = $locale   if $locale;
767        if ( scalar keys %filter ) {
768            $criteria{filter_on_metadata} = \%filter;
769        }
770    }
771    elsif($feed_listing eq "node_all_versions") {
772        $criteria{name} = $args{name};
773    }
774
775
776    # Get the feed object, and the content type
777    my ($feed,$content_type) = $self->get_feed_and_content_type($feed_type);
778
779    my $output = "Content-Type: ".$content_type."\n";
780   
781    # Get the feed, and the timestamp, in one go
782    my ($feed_output, $feed_timestamp) = 
783        $feed->make_feed( %criteria );
784
785    $output .= "Last-Modified: " . $feed_timestamp . "\n\n";
786    $output .= $feed_output;
787
788    return $output if $return_output;
789    print $output;
790}
791
792sub display_about {
793    my ($self, %args) = @_;
794
795    my $output;
796
797    if ($args{format} && $args{format} =~ /^rdf$/i) {
798        $output = qq{Content-Type: application/rdf+xml
799
800<?xml version="1.0" encoding="UTF-8"?>
801<rdf:RDF xmlns      = "http://usefulinc.com/ns/doap#"
802         xmlns:rdf  = "http://www.w3.org/1999/02/22-rdf-syntax-ns#"
803         xmlns:foaf = "http://xmlns.com/foaf/0.1/">
804<Project rdf:ID="OpenGuides">
805  <name>OpenGuides</name>
806
807  <created>2003-04-29</created>
808 
809  <shortdesc xml:lang="en">
810    A wiki engine for collaborative description of places with specialised
811    geodata metadata features.
812  </shortdesc>
813
814  <description xml:lang="en">
815    OpenGuides is a collaborative wiki environment, written in Perl, for
816    building guides and sharing information, as both human-readable text
817    and RDF. The engine contains a number of geodata-specific metadata
818    mechanisms such as locale search, node classification and integration
819    with Google Maps.
820  </description>
821
822  <homepage rdf:resource="http://openguides.org/" />
823  <mailing-list rdf:resource="http://openguides.org/mm/listinfo/openguides-dev/" />
824  <mailing-list rdf:resource="http://urchin.earth.li/mailman/listinfo/openguides-commits/" />
825
826  <maintainer>
827    <foaf:Person rdf:ID="OpenGuidesMaintainer">
828      <foaf:name>Dominic Hargreaves</foaf:name>
829      <foaf:homepage rdf:resource="http://www.larted.org.uk/~dom/" />
830    </foaf:Person>
831  </maintainer>
832
833  <repository>
834    <SVNRepository rdf:ID="OpenGuidesSVN">
835      <location rdf:resource="https://urchin.earth.li/svn/openguides/" />
836      <browse rdf:resource="http://dev.openguides.org/browser" />
837    </SVNRepository>
838  </repository>
839
840  <release>
841    <Version rdf:ID="OpenGuidesVersion">
842      <revision>$VERSION</revision>
843    </Version>
844  </release>
845
846  <download-page rdf:resource="http://search.cpan.org/dist/OpenGuides/" />
847 
848  <!-- Freshmeat category: Internet :: WWW/HTTP :: Dynamic Content -->
849  <category rdf:resource="http://freshmeat.net/browse/92/" />
850 
851  <license rdf:resource="http://www.opensource.org/licenses/gpl-license.php" />
852  <license rdf:resource="http://www.opensource.org/licenses/artistic-license.php" />
853
854</Project>
855
856</rdf:RDF>};
857    }
858    else {
859        my $site_name  = $self->config->{site_name};
860        my $script_name = $self->config->{script_name};
861        $output = qq{Content-Type: text/html; charset=utf-8
862
863<html>
864<head>
865  <title>About $site_name</title>
866<style type="text/css">
867body        { margin: 0px; }
868#content    { padding: 50px; margin: auto; width: 50%; }
869h1          { margin-bottom: 0px; font-style: italic; }
870h2          { margin-top: 0px; }
871#logo       { text-align: center; }
872#about      { margin: 0em 0em 1em 0em; border-top: 1px solid #ddd; border-bottom: 1px solid #ddd; }
873#meta       { font-size: small; text-align: center;}
874</style>
875<link rel="alternate"
876  type="application/rdf+xml"
877  title="DOAP (Description Of A Project) profile for this site's software"
878  href="$script_name?action=about;format=rdf" />
879</head>
880<body>
881<div id="content">
882<div id="logo">
883<a href="http://openguides.org/"><img
884src="http://openguides.org/img/logo.png" alt="OpenGuides"></a>
885<h1><a href="$script_name">$site_name</a></h1>
886<h2>is powered by <a href="http://openguides.org/">OpenGuides</a> -<br>
887the guides made by you.</h2>
888<h3>version <a href="http://search.cpan.org/~dom/OpenGuides-$VERSION">$VERSION</a></h3>
889</div>
890<div id="about">
891<p>
892<a href="http://www.w3.org/RDF/"><img
893src="http://openguides.org/img/rdf_icon.png" width="44" height="48"
894style="float: right; margin-left: 10px; border: 0px"></a> OpenGuides is a
895web-based collaborative <a href="http://wiki.org/wiki.cgi?WhatIsWiki">wiki</a>
896environment for building guides and sharing information, as both
897human-readable text and <a href="http://www.w3.org/RDF/"><acronym
898title="Resource Description Framework">RDF</acronym></a>. The engine contains
899a number of geodata-specific metadata mechanisms such as locale search, node
900classification and integration with <a href="http://maps.google.com/">Google
901Maps</a>.
902</p>
903<p>
904OpenGuides is written in <a href="http://www.perl.org/">Perl</a>, and is
905made available under the same license as Perl itself (dual <a
906href="http://dev.perl.org/licenses/artistic.html" title='The "Artistic Licence"'>Artistic</a> and <a
907href="http://www.opensource.org/licenses/gpl-license.php"><acronym
908title="GNU Public Licence">GPL</acronym></a>). Developer information for the
909project is available from the <a href="http://dev.openguides.org/">OpenGuides
910development site</a>.
911</p>
912<p>
913Copyright &copy;2003-2006, <a href="http://openguides.org/">The OpenGuides
914Project</a>. "OpenGuides", "[The] Open Guide To..." and "The guides made by
915you" are trademarks of The OpenGuides Project. Any uses on this site are made
916with permission.
917</p>
918</div>
919<div id="meta">
920<a href="$script_name?action=about;format=rdf"><acronym
921title="Description Of A Project">DOAP</acronym> RDF version of this
922information</a>
923</div>
924</div>
925</body>
926</html>};
927    }
928   
929    return $output if $args{return_output};
930    print $output;
931}
932
933=item B<commit_node>
934
935  $guide->commit_node(
936                         id      => $node,
937                         cgi_obj => $q,
938                     );
939
940As with other methods, parameters C<return_tt_vars> and
941C<return_output> can be used to return these things instead of
942printing the output to STDOUT.
943
944The geographical data that you should provide in the L<CGI> object
945depends on the handler you chose in C<wiki.conf>.
946
947=over
948
949=item *
950
951B<British National Grid> - provide either C<os_x> and C<os_y> or
952C<latitude> and C<longitude>; whichever set of data you give, it will
953be converted to the other and both sets will be stored.
954
955=item *
956
957B<Irish National Grid> - provide either C<osie_x> and C<osie_y> or
958C<latitude> and C<longitude>; whichever set of data you give, it will
959be converted to the other and both sets will be stored.
960
961=item *
962
963B<UTM ellipsoid> - provide C<latitude> and C<longitude>; these will be
964converted to easting and northing and both sets of data will be stored.
965
966=back
967
968=cut
969
970sub commit_node {
971    my ($self, %args) = @_;
972    my $node = $args{id};
973    my $q = $args{cgi_obj};
974    my $return_output = $args{return_output};
975    my $wiki = $self->wiki;
976    my $config = $self->config;
977
978    my $content  = $q->param("content");
979    $content =~ s/\r\n/\n/gs;
980    my $checksum = $q->param("checksum");
981
982    my %metadata = OpenGuides::Template->extract_metadata_vars(
983        wiki    => $wiki,
984        config  => $config,
985        cgi_obj => $q
986    );
987
988    delete $metadata{website} if $metadata{website} eq 'http://';
989
990    $metadata{opening_hours_text} = $q->param("hours_text") || "";
991
992    # Pick out the unmunged versions of lat/long if they're set.
993    # (If they're not, it means they weren't munged in the first place.)
994    $metadata{latitude} = delete $metadata{latitude_unmunged}
995        if $metadata{latitude_unmunged};
996    $metadata{longitude} = delete $metadata{longitude_unmunged}
997        if $metadata{longitude_unmunged};
998
999    # Check to make sure all the indexable nodes are created
1000    # Skip this for nodes needing moderation - this occurs for them once
1001    #  they've been moderated
1002    unless($wiki->node_required_moderation($node)) {
1003        $self->_autoCreateCategoryLocale(
1004                                          id       => $node,
1005                                          metadata => \%metadata
1006        );
1007    }
1008   
1009    foreach my $var ( qw( summary username comment edit_type ) ) {
1010        $metadata{$var} = $q->param($var) || "";
1011    }
1012    $metadata{host} = $ENV{REMOTE_ADDR};
1013
1014    # Wiki::Toolkit::Plugin::RSS::ModWiki wants "major_change" to be set.
1015    $metadata{major_change} = ( $metadata{edit_type} eq "Normal edit" )
1016                            ? 1
1017                            : 0;
1018
1019    my $written = $wiki->write_node($node, $content, $checksum, \%metadata );
1020
1021    if ($written) {
1022        my $output = $self->redirect_to_node($node);
1023        return $output if $return_output;
1024        print $output;
1025    } else {
1026        my %node_data = $wiki->retrieve_node($node);
1027        my %tt_vars = ( checksum       => $node_data{checksum},
1028                        new_content    => $content,
1029                        stored_content => $node_data{content} );
1030        foreach my $mdvar ( keys %metadata ) {
1031            if ($mdvar eq "locales") {
1032                $tt_vars{"stored_$mdvar"} = $node_data{metadata}{locale};
1033                $tt_vars{"new_$mdvar"}    = $metadata{locale};
1034            } elsif ($mdvar eq "categories") {
1035                $tt_vars{"stored_$mdvar"} = $node_data{metadata}{category};
1036                $tt_vars{"new_$mdvar"}    = $metadata{category};
1037            } elsif ($mdvar eq "username" or $mdvar eq "comment"
1038                      or $mdvar eq "edit_type" ) {
1039                $tt_vars{$mdvar} = $metadata{$mdvar};
1040            } else {
1041                $tt_vars{"stored_$mdvar"} = $node_data{metadata}{$mdvar}[0];
1042                $tt_vars{"new_$mdvar"}    = $metadata{$mdvar};
1043            }
1044        }
1045        return %tt_vars if $args{return_tt_vars};
1046        my $output = $self->process_template(
1047                                              id       => $node,
1048                                              template => "edit_conflict.tt",
1049                                              tt_vars  => \%tt_vars,
1050                                            );
1051        return $output if $args{return_output};
1052        print $output;
1053    }
1054}
1055
1056=item B<_autoCreateCategoryLocale>
1057
1058  $guide->_autoCreateCategoryLocale(
1059                         id       => "FAQ",
1060                         metadata => \%metadata,
1061                     );
1062
1063When a new node is added, or a previously un-moderated node is moderated,
1064identifies if any of its Categories or Locales are missing, and creates them.
1065
1066For nodes not requiring moderation, should be called on writing the node
1067For nodes requiring moderation, should only be called on moderation
1068=cut
1069sub _autoCreateCategoryLocale {
1070    my ($self, %args) = @_;
1071
1072    my $wiki = $self->wiki;
1073    my $id = $args{'id'};
1074    my %metadata = %{$args{'metadata'}};
1075
1076    # Check to make sure all the indexable nodes are created
1077    foreach my $type (qw(Category Locale)) {
1078        my $lctype = lc($type);
1079        foreach my $index (@{$metadata{$lctype}}) {
1080            $index =~ s/(.*)/\u$1/;
1081            my $node = $type . " " . $index;
1082            # Uppercase the node name before checking for existence
1083            $node =~ s/ (\S+)/ \u$1/g;
1084            unless ( $wiki->node_exists($node) ) {
1085                my $category = $type eq "Category" ? "Category" : "Locales";
1086                $wiki->write_node(
1087                                     $node,
1088                                     "\@INDEX_LINK [[$node]]",
1089                                     undef,
1090                                     {
1091                                         username => "Auto Create",
1092                                         comment  => "Auto created $lctype stub page",
1093                                         category => $category
1094                                     }
1095                );
1096            }
1097        }
1098    }
1099}
1100
1101
1102=item B<delete_node>
1103
1104  $guide->delete_node(
1105                         id       => "FAQ",
1106                         version  => 15,
1107                         password => "beer",
1108                     );
1109
1110C<version> is optional - if it isn't supplied then all versions of the
1111node will be deleted; in other words the node will be entirely
1112removed.
1113
1114If C<password> is not supplied then a form for entering the password
1115will be displayed.
1116
1117As with other methods, parameters C<return_tt_vars> and
1118C<return_output> can be used to return these things instead of
1119printing the output to STDOUT.
1120
1121=cut
1122
1123sub delete_node {
1124    my ($self, %args) = @_;
1125    my $node = $args{id} or croak "No node ID supplied for deletion";
1126    my $return_tt_vars = $args{return_tt_vars} || 0;
1127    my $return_output = $args{return_output} || 0;
1128
1129    my %tt_vars = (
1130                      not_editable  => 1,
1131                      not_deletable => 1,
1132                      deter_robots  => 1,
1133                  );
1134    $tt_vars{delete_version} = $args{version} || "";
1135
1136    my $password = $args{password};
1137
1138    if ($password) {
1139        if ($password ne $self->config->admin_pass) {
1140            return %tt_vars if $return_tt_vars;
1141            my $output = $self->process_template(
1142                                                    id       => $node,
1143                                                    template => "delete_password_wrong.tt",
1144                                                    tt_vars  => \%tt_vars,
1145                                                );
1146            return $output if $return_output;
1147            print $output;
1148        } else {
1149            $self->wiki->delete_node(
1150                                        name    => $node,
1151                                        version => $args{version},
1152                                    );
1153            # Check whether any versions of this node remain.
1154            my %check = $self->wiki->retrieve_node( name => $node );
1155            $tt_vars{other_versions_remain} = 1 if $check{version};
1156            return %tt_vars if $return_tt_vars;
1157            my $output = $self->process_template(
1158                                                    id       => $node,
1159                                                    template => "delete_done.tt",
1160                                                    tt_vars  => \%tt_vars,
1161                                                );
1162            return $output if $return_output;
1163            print $output;
1164        }
1165    } else {
1166        return %tt_vars if $return_tt_vars;
1167        my $output = $self->process_template(
1168                                                id       => $node,
1169                                                template => "delete_confirm.tt",
1170                                                tt_vars  => \%tt_vars,
1171                                            );
1172        return $output if $return_output;
1173        print $output;
1174    }
1175}
1176
1177=item B<set_node_moderation>
1178
1179  $guide->set_node_moderation(
1180                         id       => "FAQ",
1181                         password => "beer",
1182                         moderation_flag => 1,
1183                     );
1184
1185Sets the moderation needed flag on a node, either on or off.
1186
1187If C<password> is not supplied then a form for entering the password
1188will be displayed.
1189=cut
1190sub set_node_moderation {
1191    my ($self, %args) = @_;
1192    my $node = $args{id} or croak "No node ID supplied for node moderation";
1193    my $return_tt_vars = $args{return_tt_vars} || 0;
1194    my $return_output = $args{return_output} || 0;
1195
1196    # Get the moderation flag into something sane
1197    if($args{moderation_flag} eq "1" || $args{moderation_flag} eq "yes" ||
1198       $args{moderation_flag} eq "on" || $args{moderation_flag} eq "true") {
1199        $args{moderation_flag} = 1;
1200    } else {
1201        $args{moderation_flag} = 0;
1202    }
1203
1204    # Set up the TT variables
1205    my %tt_vars = (
1206                      not_editable  => 1,
1207                      not_deletable => 1,
1208                      deter_robots  => 1,
1209                      moderation_action => 'set_moderation',
1210                      moderation_flag   => $args{moderation_flag},
1211                      moderation_url_args => 'action=set_moderation;moderation_flag='.$args{moderation_flag},
1212                  );
1213
1214    my $password = $args{password};
1215
1216    if ($password) {
1217        if ($password ne $self->config->admin_pass) {
1218            return %tt_vars if $return_tt_vars;
1219            my $output = $self->process_template(
1220                                                    id       => $node,
1221                                                    template => "moderate_password_wrong.tt",
1222                                                    tt_vars  => \%tt_vars,
1223                                                );
1224            return $output if $return_output;
1225            print $output;
1226        } else {
1227            $self->wiki->set_node_moderation(
1228                                        name    => $node,
1229                                        required => $args{moderation_flag},
1230                                    );
1231
1232            # Send back to the admin interface
1233            my $script_url = $self->config->script_url;
1234            my $script_name = $self->config->script_name;
1235            my $q = CGI->new;
1236            my $output = $q->redirect( $script_url.$script_name."?action=admin;moderation=changed" );
1237            return $output if $return_output;
1238            print $output;
1239        }
1240    } else {
1241        return %tt_vars if $return_tt_vars;
1242        my $output = $self->process_template(
1243                                                id       => $node,
1244                                                template => "moderate_confirm.tt",
1245                                                tt_vars  => \%tt_vars,
1246                                            );
1247        return $output if $return_output;
1248        print $output;
1249    }
1250}
1251
1252=item B<moderate_node>
1253
1254  $guide->moderate_node(
1255                         id       => "FAQ",
1256                         version  => 12,
1257                         password => "beer",
1258                     );
1259
1260Marks a version of a node as moderated. Will also auto-create and Locales
1261and Categories for the newly moderated version.
1262
1263If C<password> is not supplied then a form for entering the password
1264will be displayed.
1265=cut
1266sub moderate_node {
1267    my ($self, %args) = @_;
1268    my $node = $args{id} or croak "No node ID supplied for node moderation";
1269    my $version = $args{version} or croak "No node version supplied for node moderation";
1270    my $return_tt_vars = $args{return_tt_vars} || 0;
1271    my $return_output = $args{return_output} || 0;
1272
1273    # Set up the TT variables
1274    my %tt_vars = (
1275                      not_editable  => 1,
1276                      not_deletable => 1,
1277                      deter_robots  => 1,
1278                      version       => $version,
1279                      moderation_action => 'moderate',
1280                      moderation_url_args => 'action=moderate;version='.$version
1281                  );
1282
1283    my $password = $args{password};
1284    unless($self->config->moderation_requires_password) {
1285        $password = $self->config->admin_pass;
1286    }
1287
1288    if ($password) {
1289        if ($password ne $self->config->admin_pass) {
1290            return %tt_vars if $return_tt_vars;
1291            my $output = $self->process_template(
1292                                                    id       => $node,
1293                                                    template => "moderate_password_wrong.tt",
1294                                                    tt_vars  => \%tt_vars,
1295                                                );
1296            return $output if $return_output;
1297            print $output;
1298        } else {
1299            $self->wiki->moderate_node(
1300                                        name    => $node,
1301                                        version => $version
1302                                    );
1303
1304            # Create any categories or locales for it
1305            my %details = $self->wiki->retrieve_node(
1306                                        name    => $node,
1307                                        version => $version
1308                                    );
1309            $self->_autoCreateCategoryLocale(
1310                                          id       => $node,
1311                                          metadata => $details{'metadata'}
1312            );
1313
1314            # Send back to the admin interface
1315            my $script_url = $self->config->script_url;
1316            my $script_name = $self->config->script_name;
1317            my $q = CGI->new;
1318            my $output = $q->redirect( $script_url.$script_name."?action=admin;moderation=moderated" );
1319            return $output if $return_output;
1320            print $output;
1321        }
1322    } else {
1323        return %tt_vars if $return_tt_vars;
1324        my $output = $self->process_template(
1325                                                id       => $node,
1326                                                template => "moderate_confirm.tt",
1327                                                tt_vars  => \%tt_vars,
1328                                            );
1329        return $output if $return_output;
1330        print $output;
1331    }
1332}
1333
1334=item B<show_missing_metadata>
1335Search for nodes which don't have a certain kind of metadata. Optionally
1336also excludes Locales and Categories
1337=cut
1338sub show_missing_metadata {
1339    my ($self, %args) = @_;
1340    my $return_tt_vars = $args{return_tt_vars} || 0;
1341    my $return_output = $args{return_output} || 0;
1342
1343    my $wiki = $self->wiki;
1344    my $formatter = $self->wiki->formatter;
1345    my $script_name = $self->config->script_name;
1346
1347    my ($metadata_type, $metadata_value, $exclude_locales, $exclude_categories)
1348        = @args{ qw( metadata_type metadata_value exclude_locales exclude_categories ) };
1349
1350    my @nodes;
1351    my $done_search = 0;
1352
1353    # Only search if they supplied at least a metadata type
1354    if($metadata_type) {
1355        $done_search = 1;
1356        @nodes = $wiki->list_nodes_by_missing_metadata(
1357                            metadata_type => $metadata_type,
1358                            metadata_value => $metadata_value,
1359                            ignore_case    => 1,
1360        );
1361
1362        # Do we need to filter some nodes out?
1363        if($exclude_locales || $exclude_categories) {
1364            my @all_nodes = @nodes;
1365            @nodes = ();
1366
1367            foreach my $node (@all_nodes) {
1368                if($exclude_locales && $node =~ /^Locale /) { next; }
1369                if($exclude_categories && $node =~ /^Category /) { next; }
1370                push @nodes, $node;
1371            }
1372        }
1373    }
1374
1375    # Build nice edit etc links for our nodes
1376    my @tt_nodes;
1377    for my $node (@nodes) {
1378        my %n;
1379
1380        # Make the URLs
1381        my $node_param = uri_escape( $formatter->node_name_to_node_param( $node ) );
1382
1383        # Save into the hash
1384        $n{'name'} = $node;
1385        $n{'view_url'} = $script_name . "?id=" . $node_param;
1386        $n{'edit_url'} = $script_name . "?id=" . $node_param . ";action=edit";
1387        push @tt_nodes, \%n;
1388    }
1389
1390    # Set up our TT variables, including the search parameters
1391    my %tt_vars = (
1392                      not_editable  => 1,
1393                      not_deletable => 1,
1394                      deter_robots  => 1,
1395
1396                      nodes => \@tt_nodes,
1397                      done_search    => $done_search,
1398                      metadata_type  => $metadata_type,
1399                      metadata_value => $metadata_value,
1400                      exclude_locales => $exclude_locales,
1401                      exclude_categories => $exclude_categories
1402                  );
1403    return %tt_vars if $return_tt_vars;
1404
1405    # Render to the page
1406    my $output = $self->process_template(
1407                                           id       => "",
1408                                           template => "missing_metadata.tt",
1409                                           tt_vars  => \%tt_vars,
1410                                        );
1411    return $output if $return_output;
1412    print $output;
1413}
1414
1415=item B<display_admin_interface>
1416Fetch everything we need to display the admin interface, and passes it off
1417 to the template
1418=cut
1419sub display_admin_interface {
1420    my ($self, %args) = @_;
1421    my $return_tt_vars = $args{return_tt_vars} || 0;
1422    my $return_output = $args{return_output} || 0;
1423
1424    my $wiki = $self->wiki;
1425    my $formatter = $self->wiki->formatter;
1426    my $script_name = $self->config->script_name;
1427
1428    # Grab all the recent nodes
1429    my @all_nodes = $wiki->list_recent_changes(last_n_changes => 100);
1430
1431    # Split into nodes, Locales and Categories
1432    my @nodes;
1433    my @categories;
1434    my @locales;
1435    for my $node (@all_nodes) {
1436        # Add moderation status
1437        $node->{'moderate'} = $wiki->node_required_moderation($node->{'name'});
1438
1439        # Make the URLs
1440        my $node_param = uri_escape( $formatter->node_name_to_node_param( $node->{'name'} ) );
1441        $node->{'view_url'} = $script_name . "?id=" . $node_param;
1442        $node->{'versions_url'} = $script_name .
1443                        "?action=list_all_versions;id=" . $node_param;
1444        $node->{'moderation_url'} = $script_name .
1445                        "?action=set_moderation;id=" . $node_param;
1446
1447        # Filter
1448        if($node->{'name'} =~ /^Category /) {
1449            $node->{'page_name'} = $node->{'name'};
1450            $node->{'name'} =~ s/^Category //;
1451            push @categories, $node;
1452        } elsif($node->{'name'} =~ /^Locale /) {
1453            $node->{'page_name'} = $node->{'name'};
1454            $node->{'name'} =~ s/^Locale //;
1455            push @locales, $node;
1456        } else {
1457            push @nodes, $node;
1458        }
1459    }
1460
1461    # Handle completed notice for actions
1462    my $completed_action = "";
1463    if($args{moderation_completed}) {
1464        if($args{moderation_completed} eq "moderation") {
1465            $completed_action = "Version moderated";
1466        }
1467        if($args{moderation_completed} eq "changed") {
1468            $completed_action = "Node moderation flag changed";
1469        }
1470    }
1471
1472    # Render in a template
1473    my %tt_vars = (
1474                      not_editable  => 1,
1475                      not_deletable => 1,
1476                      deter_robots  => 1,
1477                      nodes      => \@nodes,
1478                      categories => \@categories,
1479                      locales    => \@locales,
1480                      completed_action => $completed_action
1481                  );
1482    return %tt_vars if $return_tt_vars;
1483    my $output = $self->process_template(
1484                                           id       => "",
1485                                           template => "admin_home.tt",
1486                                           tt_vars  => \%tt_vars,
1487                                        );
1488    return $output if $return_output;
1489    print $output;
1490}
1491
1492sub process_template {
1493    my ($self, %args) = @_;
1494    my %output_conf = (
1495                          wiki     => $self->wiki,
1496                          config   => $self->config,
1497                          node     => $args{id},
1498                          template => $args{template},
1499                          vars     => $args{tt_vars},
1500                          cookies  => $args{cookies},
1501                      );
1502    if ( $args{content_type} ) {
1503        $output_conf{content_type} = $args{content_type};
1504    }
1505    return OpenGuides::Template->output( %output_conf );
1506}
1507
1508sub redirect_to_node {
1509    my ($self, $node, $redirected_from) = @_;
1510   
1511    my $script_url = $self->config->script_url;
1512    my $script_name = $self->config->script_name;
1513    my $formatter = $self->wiki->formatter;
1514
1515    my $id = $formatter->node_name_to_node_param( $node );
1516    my $oldid;
1517    $oldid = $formatter->node_name_to_node_param( $redirected_from ) if $redirected_from;
1518
1519    my $redir_param = "$script_url$script_name?";
1520    $redir_param .= 'id=' if $oldid;
1521    $redir_param .= $id;
1522    $redir_param .= ";oldid=$oldid" if $oldid;
1523   
1524    my $q = CGI->new;
1525    return $q->redirect( $redir_param );
1526}
1527
1528sub get_cookie {
1529    my $self = shift;
1530    my $config = $self->config;
1531    my $pref_name = shift or return "";
1532    my %cookie_data = OpenGuides::CGI->get_prefs_from_cookie(config=>$config);
1533    return $cookie_data{$pref_name};
1534}
1535
1536
1537=head1 BUGS AND CAVEATS
1538
1539UTF8 data are currently not handled correctly throughout.
1540
1541Other bugs are documented at
1542L<http://dev.openguides.org/>
1543
1544=head1 SEE ALSO
1545
1546=over 4
1547
1548=item * L<http://london.openguides.org/|The Open Guide to London>, the first and biggest OpenGuides site.
1549
1550=item * L<http://openguides.org/|The OpenGuides website>, with a list of all live OpenGuides installs.
1551
1552=item * L<Wiki::Toolkit>, the Wiki toolkit which does the heavy lifting for OpenGuides
1553
1554=back
1555
1556=head1 FEEDBACK
1557
1558If you have a question, a bug report, or a patch, or you're interested
1559in joining the development team, please contact openguides-dev@openguides.org
1560(moderated mailing list, will reach all current developers but you'll have
1561to wait for your post to be approved) or file a bug report at
1562L<http://dev.openguides.org/>
1563
1564=head1 AUTHOR
1565
1566The OpenGuides Project (openguides-dev@openguides.org)
1567
1568=head1 COPYRIGHT
1569
1570     Copyright (C) 2003-2006 The OpenGuides Project.  All Rights Reserved.
1571
1572The OpenGuides distribution is free software; you can redistribute it
1573and/or modify it under the same terms as Perl itself.
1574
1575=head1 CREDITS
1576
1577Programming by Dominic Hargreaves, Earle Martin, Kake Pugh, and Ivor
1578Williams.  Testing and bug reporting by Billy Abbott, Jody Belka,
1579Kerry Bosworth, Simon Cozens, Cal Henderson, Steve Jolly, and Bob
1580Walker (among others).  Much of the Module::Build stuff copied from
1581the Siesta project L<http://siesta.unixbeard.net/>
1582
1583=cut
1584
15851;
Note: See TracBrowser for help on using the repository browser.