source: trunk/lib/OpenGuides.pm @ 781

Last change on this file since 781 was 781, checked in by Dominic Hargreaves, 16 years ago

Development version.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 40.5 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::Feed;
10use OpenGuides::Template;
11use OpenGuides::Utils;
12use Time::Piece;
13use URI::Escape;
14
15use vars qw( $VERSION );
16
17$VERSION = '0.54-svn';
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 = CGI::Wiki::Plugin::Locator::Grid->new(
54                                             x => "os_x",    y => "os_y" );
55    } elsif ( $geo_handler == 2 ) {
56        $locator = CGI::Wiki::Plugin::Locator::Grid->new(
57                                             x => "osie_x",  y => "osie_y" );
58    } else {
59        $locator = CGI::Wiki::Plugin::Locator::Grid->new(
60                                             x => "easting", y => "northing" );
61    }
62    $wiki->register_plugin( plugin => $locator );
63    $self->{locator} = $locator;
64    my $differ = CGI::Wiki::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<CGI::Wiki> 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<CGI::Wiki::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<CGI::Wiki::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    }
160
161    my %current_data = $wiki->retrieve_node( $id );
162    my $current_version = $current_data{version};
163    undef $version if ($version && $version == $current_version);
164    my %criteria = ( name => $id );
165    $criteria{version} = $version if $version; # retrieve_node default is current
166
167    my %node_data = $wiki->retrieve_node( %criteria );
168
169    # Fixes passing undefined values to Text::Wikiformat if node doesn't exist.
170    my $raw        = $node_data{content} || " ";
171    my $content    = $wiki->format($raw);
172    my $modified   = $node_data{last_modified};
173    my %metadata   = %{$node_data{metadata}};
174
175    my ($wgs84_long, $wgs84_lat) = OpenGuides::Utils->get_wgs84_coords(
176                                        longitude => $metadata{longitude}[0],
177                                        latitude => $metadata{latitude}[0],
178                                        config => $config);
179    if ($args{format} && $args{format} eq 'raw') {
180      print "Content-Type: text/plain\n\n";
181      print $raw;
182      return 0;
183    }
184   
185    my %metadata_vars = OpenGuides::Template->extract_metadata_vars(
186                            wiki     => $wiki,
187                            config   => $config,
188                            metadata => $node_data{metadata}
189                        );
190
191    %tt_vars = (
192                   %tt_vars,
193                   %metadata_vars,
194                   content       => $content,
195                   last_modified => $modified,
196                   version       => $node_data{version},
197                   node          => $id,
198                   language      => $config->default_language,
199                   oldid         => $oldid,
200                   enable_gmaps  => 1,
201                   display_google_maps => $self->get_cookie("display_google_maps"),
202                   wgs84_long    => $wgs84_long,
203                   wgs84_lat     => $wgs84_lat
204               );
205
206    if ( $raw =~ /^#REDIRECT\s+(.+?)\s*$/ ) {
207        my $redirect = $1;
208        # Strip off enclosing [[ ]] in case this is an extended link.
209        $redirect =~ s/^\[\[//;
210        $redirect =~ s/\]\]\s*$//;
211
212        # Don't redirect if the parameter "redirect" is given as 0.
213        if ($do_redirect == 0) {
214            return %tt_vars if $args{return_tt_vars};
215            $tt_vars{current} = 1;
216            my $output = $self->process_template(
217                                                  id            => $id,
218                                                  template      => "node.tt",
219                                                  tt_vars       => \%tt_vars,
220                                                );
221            return $output if $return_output;
222            print $output;
223        } elsif ( $wiki->node_exists($redirect) && $redirect ne $id && $redirect ne $oldid ) {
224            # Avoid loops by not generating redirects to the same node or the previous node.
225            my $output = $self->redirect_to_node($redirect, $id);
226            return $output if $return_output;
227            print $output;
228            return 0;
229        }
230    }
231
232    # We've undef'ed $version above if this is the current version.
233    $tt_vars{current} = 1 unless $version;
234
235    if ($id eq "RecentChanges") {
236        $self->display_recent_changes(%args);
237    } elsif ( $id eq $self->config->home_name ) {
238        my @recent = $wiki->list_recent_changes(
239            last_n_changes => 10,
240            metadata_was   => { edit_type => "Normal edit" },
241        );
242        @recent = map {
243                          {
244                              name          => CGI->escapeHTML($_->{name}),
245                              last_modified => CGI->escapeHTML($_->{last_modified}),
246                              version       => CGI->escapeHTML($_->{version}),
247                              comment       => CGI->escapeHTML($_->{metadata}{comment}[0]),
248                              username      => CGI->escapeHTML($_->{metadata}{username}[0]),
249                              url           => $config->script_name . "?"
250                                               . CGI->escape($wiki->formatter->node_name_to_node_param($_->{name}))
251                          }
252                      } @recent;
253        $tt_vars{recent_changes} = \@recent;
254        return %tt_vars if $args{return_tt_vars};
255        my $output = $self->process_template(
256                                                id            => $id,
257                                                template      => "home_node.tt",
258                                                tt_vars       => \%tt_vars,
259                                            );
260        return $output if $return_output;
261        print $output;
262    } else {
263        return %tt_vars if $args{return_tt_vars};
264        my $output = $self->process_template(
265                                                id            => $id,
266                                                template      => "node.tt",
267                                                tt_vars       => \%tt_vars,
268                                            );
269        return $output if $return_output;
270        print $output;
271    }
272}
273
274=item B<display_recent_changes> 
275
276  $guide->display_recent_changes;
277
278As with other methods, the C<return_output> parameter can be used to
279return the output instead of printing it to STDOUT.
280
281=cut
282
283sub display_recent_changes {
284    my ($self, %args) = @_;
285    my $config = $self->config;
286    my $wiki = $self->wiki;
287    my $minor_edits = $self->get_cookie( "show_minor_edits_in_rc" );
288    my $id = $args{id} || $self->config->home_name;
289    my $return_output = $args{return_output} || 0;
290    my (%tt_vars, %recent_changes);
291    my $q = CGI->new;
292    my $since = $q->param("since");
293    if ( $since ) {
294        $tt_vars{since} = $since;
295        my $t = localtime($since); # overloaded by Time::Piece
296        $tt_vars{since_string} = $t->strftime;
297        my %criteria = ( since => $since );   
298        $criteria{metadata_was} = { edit_type => "Normal edit" }
299          unless $minor_edits;
300        my @rc = $self->{wiki}->list_recent_changes( %criteria );
301 
302        @rc = map {
303            {
304              name        => CGI->escapeHTML($_->{name}),
305              last_modified => CGI->escapeHTML($_->{last_modified}),
306              version     => CGI->escapeHTML($_->{version}),
307              comment     => CGI->escapeHTML($_->{metadata}{comment}[0]),
308              username    => CGI->escapeHTML($_->{metadata}{username}[0]),
309              host        => CGI->escapeHTML($_->{metadata}{host}[0]),
310              username_param => CGI->escape($_->{metadata}{username}[0]),
311              edit_type   => CGI->escapeHTML($_->{metadata}{edit_type}[0]),
312              url         => $config->script_name . "?"
313      . CGI->escape($wiki->formatter->node_name_to_node_param($_->{name})),
314        }
315                   } @rc;
316        if ( scalar @rc ) {
317            $recent_changes{since} = \@rc; 
318        }
319    } else {
320        for my $days ( [0, 1], [1, 7], [7, 14], [14, 30] ) {
321            my %criteria = ( between_days => $days );
322            $criteria{metadata_was} = { edit_type => "Normal edit" }
323              unless $minor_edits;
324            my @rc = $self->{wiki}->list_recent_changes( %criteria );
325
326            @rc = map {
327            {
328              name        => CGI->escapeHTML($_->{name}),
329              last_modified => CGI->escapeHTML($_->{last_modified}),
330              version     => CGI->escapeHTML($_->{version}),
331              comment     => CGI->escapeHTML($_->{metadata}{comment}[0]),
332              username    => CGI->escapeHTML($_->{metadata}{username}[0]),
333              host        => CGI->escapeHTML($_->{metadata}{host}[0]),
334              username_param => CGI->escape($_->{metadata}{username}[0]),
335              edit_type   => CGI->escapeHTML($_->{metadata}{edit_type}[0]),
336              url         => $config->script_name . "?"
337      . CGI->escape($wiki->formatter->node_name_to_node_param($_->{name})),
338        }
339                       } @rc;
340            if ( scalar @rc ) {
341                $recent_changes{$days->[1]} = \@rc;
342        }
343        }
344    }
345    $tt_vars{recent_changes} = \%recent_changes;
346    my %processing_args = (
347                            id            => $id,
348                            template      => "recent_changes.tt",
349                            tt_vars       => \%tt_vars,
350                           );
351    if ( !$since && $self->get_cookie("track_recent_changes_views") ) {
352    my $cookie =
353           OpenGuides::CGI->make_recent_changes_cookie(config => $config );
354        $processing_args{cookies} = $cookie;
355        $tt_vars{last_viewed} = OpenGuides::CGI->get_last_recent_changes_visit_from_cookie( config => $config );
356    }
357    return %tt_vars if $args{return_tt_vars};
358    my $output = $self->process_template( %processing_args );
359    return $output if $return_output;
360    print $output;
361}
362
363=item B<display_diffs>
364
365  $guide->display_diffs(
366                           id            => "Home Page",
367                           version       => 6,
368                           other_version => 5,
369                       );
370
371  # Or return output as a string (useful for writing tests).
372  my $output = $guide->display_diffs(
373                                        id            => "Home Page",
374                                        version       => 6,
375                                        other_version => 5,
376                                        return_output => 1,
377                                    );
378
379  # Or return the hash of variables that will be passed to the template
380  # (not including those set additionally by OpenGuides::Template).
381  my %vars = $guide->display_diffs(
382                                      id             => "Home Page",
383                                      version        => 6,
384                                      other_version  => 5,
385                                      return_tt_vars => 1,
386                                  );
387
388=cut
389
390sub display_diffs {
391    my ($self, %args) = @_;
392    my %diff_vars = $self->differ->differences(
393                                                  node          => $args{id},
394                                                  left_version  => $args{version},
395                                                  right_version => $args{other_version},
396                                              );
397    $diff_vars{not_deletable} = 1;
398    $diff_vars{not_editable}  = 1;
399    $diff_vars{deter_robots}  = 1;
400    return %diff_vars if $args{return_tt_vars};
401    my $output = $self->process_template(
402                                            id       => $args{id},
403                                            template => "differences.tt",
404                                            tt_vars  => \%diff_vars
405                                        );
406    return $output if $args{return_output};
407    print $output;
408}
409
410=item B<find_within_distance>
411
412  $guide->find_within_distance(
413                                  id => $node,
414                                  metres => $q->param("distance_in_metres")
415                              );
416
417=cut
418
419sub find_within_distance {
420    my ($self, %args) = @_;
421    my $node = $args{id};
422    my $metres = $args{metres};
423    my %data = $self->wiki->retrieve_node( $node );
424    my $lat = $data{metadata}{latitude}[0];
425    my $long = $data{metadata}{longitude}[0];
426    my $script_url = $self->config->script_url;
427    my $q = CGI->new;
428    print $q->redirect( $script_url . "search.cgi?lat=$lat;long=$long;distance_in_metres=$metres" );
429}
430
431=item B<show_backlinks>
432
433  $guide->show_backlinks( id => "Calthorpe Arms" );
434
435As with other methods, parameters C<return_tt_vars> and
436C<return_output> can be used to return these things instead of
437printing the output to STDOUT.
438
439=cut
440
441sub show_backlinks {
442    my ($self, %args) = @_;
443    my $wiki = $self->wiki;
444    my $formatter = $wiki->formatter;
445
446    my @backlinks = $wiki->list_backlinks( node => $args{id} );
447    my @results = map {
448                          {
449                              url   => CGI->escape($formatter->node_name_to_node_param($_)),
450                              title => CGI->escapeHTML($_)
451                          }
452                      } sort @backlinks;
453    my %tt_vars = ( results       => \@results,
454                    num_results   => scalar @results,
455                    not_deletable => 1,
456                    deter_robots  => 1,
457                    not_editable  => 1 );
458    return %tt_vars if $args{return_tt_vars};
459    my $output = OpenGuides::Template->output(
460                                                 node    => $args{id},
461                                                 wiki    => $wiki,
462                                                 config  => $self->config,
463                                                 template=>"backlink_results.tt",
464                                                 vars    => \%tt_vars,
465                                             );
466    return $output if $args{return_output};
467    print $output;
468}
469
470=item B<show_index>
471
472  $guide->show_index(
473                        type   => "category",
474                        value  => "pubs",
475                    );
476
477  # RDF version.
478  $guide->show_index(
479                        type   => "locale",
480                        value  => "Holborn",
481                        format => "rdf",
482                    );
483
484  # Or return output as a string (useful for writing tests).
485  $guide->show_index(
486                        type          => "category",
487                        value         => "pubs",
488                        return_output => 1,
489                    );
490
491=cut
492
493sub show_index {
494    my ($self, %args) = @_;
495    my $wiki = $self->wiki;
496    my $formatter = $wiki->formatter;
497    my %tt_vars;
498    my @selnodes;
499
500    if ( $args{type} and $args{value} ) {
501        if ( $args{type} eq "fuzzy_title_match" ) {
502            my %finds = $wiki->fuzzy_title_match( $args{value} );
503            @selnodes = sort { $finds{$a} <=> $finds{$b} } keys %finds;
504            $tt_vars{criterion} = {
505                type  => $args{type},  # for RDF version
506                value => $args{value}, # for RDF version
507                name  => CGI->escapeHTML("Fuzzy Title Match on '$args{value}'")
508            };
509            $tt_vars{not_editable} = 1;
510        } else {
511            @selnodes = $wiki->list_nodes_by_metadata(
512                metadata_type  => $args{type},
513                metadata_value => $args{value},
514                ignore_case    => 1
515            );
516            my $name = ucfirst($args{type}) . " $args{value}";
517            my $url = $self->config->script_name
518                      . "?"
519                      . ucfirst( $args{type} )
520                      . "_"
521                      . uri_escape(
522                                      $formatter->node_name_to_node_param($args{value})
523                                  );
524            $tt_vars{criterion} = {
525                type  => $args{type},
526                value => $args{value}, # for RDF version
527                name  => CGI->escapeHTML( $name ),
528                url   => $url
529            };
530            $tt_vars{not_editable} = 1;
531        }
532    } else {
533        @selnodes = $wiki->list_all_nodes();
534    }
535
536    my @nodes = map {
537                        {
538                            name      => $_,
539                            node_data => { $wiki->retrieve_node( name => $_ ) },
540                            param     => $formatter->node_name_to_node_param($_) }
541                        } sort @selnodes;
542
543    $tt_vars{nodes} = \@nodes;
544
545    my ($template, %conf);
546
547    if ( $args{format} ) {
548        if ( $args{format} eq "rdf" ) {
549            $template = "rdf_index.tt";
550            $conf{content_type} = "application/rdf+xml";
551        }
552        elsif ( $args{format} eq "plain" ) {
553            $template = "plain_index.tt";
554            $conf{content_type} = "text/plain";
555        } elsif ( $args{format} eq "map" ) {
556            my $q = CGI->new;
557            $tt_vars{zoom} = $q->param('zoom') || '';
558            $tt_vars{lat} = $q->param('lat') || '';
559            $tt_vars{long} = $q->param('long') || '';
560            $tt_vars{centre_long} = $self->config->centre_long;
561            $tt_vars{centre_lat} = $self->config->centre_lat;
562            $tt_vars{default_gmaps_zoom} = $self->config->default_gmaps_zoom;
563            $tt_vars{enable_gmaps} = 1;
564            $tt_vars{display_google_maps} = 1; # override for this page
565            $template = "map_index.tt";
566           
567        }
568    } else {
569        $template = "site_index.tt";
570    }
571
572    %conf = (
573                %conf,
574                node        => "$args{type} index", # KLUDGE
575                template    => $template,
576                tt_vars     => \%tt_vars,
577            );
578
579    my $output = $self->process_template( %conf );
580    return $output if $args{return_output};
581    print $output;
582}
583
584=item B<list_all_versions>
585
586  $guide->list_all_versions ( id => "Home Page" );
587
588  # Or return output as a string (useful for writing tests).
589  $guide->list_all_versions (
590                                id            => "Home Page",
591                                return_output => 1,
592                            );
593
594  # Or return the hash of variables that will be passed to the template
595  # (not including those set additionally by OpenGuides::Template).
596  $guide->list_all_versions (
597                                id             => "Home Page",
598                                return_tt_vars => 1,
599                            );
600
601=cut
602
603sub list_all_versions {
604    my ($self, %args) = @_;
605    my $return_output = $args{return_output} || 0;
606    my $node = $args{id};
607    my %curr_data = $self->wiki->retrieve_node($node);
608    my $curr_version = $curr_data{version};
609    my @history;
610    for my $version ( 1 .. $curr_version ) {
611        my %node_data = $self->wiki->retrieve_node( name    => $node,
612                                                    version => $version );
613        # $node_data{version} will be zero if this version was deleted.
614        push @history, {
615            version  => CGI->escapeHTML( $version ),
616            modified => CGI->escapeHTML( $node_data{last_modified} ),
617            username => CGI->escapeHTML( $node_data{metadata}{username}[0] ),
618            comment  => CGI->escapeHTML( $node_data{metadata}{comment}[0] ),
619                       } if $node_data{version};
620    }
621    @history = reverse @history;
622    my %tt_vars = (
623                      node          => $node,
624                      version       => $curr_version,
625                      not_deletable => 1,
626                      not_editable  => 1,
627                      deter_robots  => 1,
628                      history       => \@history
629                  );
630    return %tt_vars if $args{return_tt_vars};
631    my $output = $self->process_template(
632                                            id       => $node,
633                                            template => "node_history.tt",
634                                            tt_vars  => \%tt_vars,
635                                        );
636    return $output if $return_output;
637    print $output;
638}
639
640=item B<display_feed>
641
642  # Last ten non-minor edits to Hammersmith pages in RSS 1.0 format
643  $guide->display_feed(
644                         feed_type          => 'rss',
645                         items              => 10,
646                         ignore_minor_edits => 1,
647                         locale             => "Hammersmith",
648                     );
649
650C<feed_type> is a mandatory parameter. Supported values at present are
651"rss".
652
653As with other methods, the C<return_output> parameter can be used to
654return the output instead of printing it to STDOUT.
655
656=cut
657
658sub display_feed {
659    my ($self, %args) = @_;
660
661    my $feed_type = $args{feed_type};
662    croak "No feed type given" unless $feed_type;
663   
664    my $return_output = $args{return_output} ? 1 : 0;
665
666    my $items = $args{items} || "";
667    my $days  = $args{days}  || "";
668    my $ignore_minor_edits = $args{ignore_minor_edits} ? 1 : 0;
669    my $username = $args{username} || "";
670    my $category = $args{category} || "";
671    my $locale   = $args{locale}   || "";
672    my %criteria = (
673                       items              => $items,
674                       days               => $days,
675                       ignore_minor_edits => $ignore_minor_edits,
676                       feed_type          => $feed_type,
677                   );
678    my %filter;
679    $filter{username} = $username if $username;
680    $filter{category} = $category if $category;
681    $filter{locale}   = $locale   if $locale;
682    if ( scalar keys %filter ) {
683        $criteria{filter_on_metadata} = \%filter;
684    }
685
686    my $feed = OpenGuides::Feed->new(
687                                        wiki       => $self->wiki,
688                                        config     => $self->config,
689                                        og_version => $VERSION,
690                                    );
691
692    my $output;
693   
694    if ($feed_type eq 'rss') {
695        $output = "Content-Type: application/rdf+xml\n";
696    } else {
697        croak "Unknown feed type given: $feed_type";
698    }
699   
700    $output .= "Last-Modified: " . $feed->feed_timestamp( %criteria ) . "\n\n";
701
702    $output .= $feed->make_feed( %criteria );
703
704    return $output if $return_output;
705    print $output;
706}
707
708sub display_about {
709    my ($self, %args) = @_;
710
711    my $output;
712
713    if ($args{format} && $args{format} =~ /^rdf$/i) {
714        $output = qq{Content-Type: application/rdf+xml
715
716<?xml version="1.0" encoding="UTF-8"?>
717<rdf:RDF xmlns      = "http://usefulinc.com/ns/doap#"
718         xmlns:rdf  = "http://www.w3.org/1999/02/22-rdf-syntax-ns#"
719         xmlns:foaf = "http://xmlns.com/foaf/0.1/">
720<Project rdf:ID="OpenGuides">
721  <name>OpenGuides</name>
722
723  <created>2003-04-29</created>
724 
725  <shortdesc xml:lang="en">
726    A wiki engine for collaborative description of places with specialised
727    geodata metadata features.
728  </shortdesc>
729
730  <description xml:lang="en">
731    OpenGuides is a collaborative wiki environment, written in Perl, for
732    building guides and sharing information, as both human-readable text
733    and RDF. The engine contains a number of geodata-specific metadata
734    mechanisms such as locale search, node classification and integration
735    with Google Maps.
736  </description>
737
738  <homepage rdf:resource="http://openguides.org/" />
739  <mailing-list rdf:resource="http://openguides.org/mm/listinfo/openguides-dev/" />
740  <mailing-list rdf:resource="http://urchin.earth.li/mailman/listinfo/openguides-commits/" />
741
742  <maintainer>
743    <foaf:Person rdf:ID="OpenGuidesMaintainer">
744      <foaf:name>Dominic Hargreaves</foaf:name>
745      <foaf:homepage rdf:resource="http://www.larted.org.uk/~dom/" />
746    </foaf:Person>
747  </maintainer>
748
749  <repository>
750    <SVNRepository rdf:ID="OpenGuidesSVN">
751      <location rdf:resource="https://urchin.earth.li/svn/openguides/" />
752      <browse rdf:resource="http://dev.openguides.org/browser" />
753    </SVNRepository>
754  </repository>
755
756  <release>
757    <Version rdf:ID="OpenGuidesVersion">
758      <revision>$VERSION</revision>
759    </Version>
760  </release>
761
762  <download-page rdf:resource="http://search.cpan.org/dist/OpenGuides/" />
763 
764  <!-- Freshmeat category: Internet :: WWW/HTTP :: Dynamic Content -->
765  <category rdf:resource="http://freshmeat.net/browse/92/" />
766 
767  <license rdf:resource="http://www.opensource.org/licenses/gpl-license.php" />
768  <license rdf:resource="http://www.opensource.org/licenses/artistic-license.php" />
769
770</Project>
771
772</rdf:RDF>};
773    }
774    else {
775        my $site_name  = $self->config->{site_name};
776        my $script_name = $self->config->{script_name};
777        $output = qq{Content-Type: text/html; charset=utf-8
778
779<html>
780<head>
781  <title>About $site_name</title>
782<style type="text/css">
783body        { margin: 0px; }
784#content    { padding: 50px; margin: auto; width: 50%; }
785h1          { margin-bottom: 0px; font-style: italic; }
786h2          { margin-top: 0px; }
787#logo       { text-align: center; }
788#logo a img { border: 1px solid #000; }
789#about      { margin: 0em 0em 1em 0em; border-top: 1px solid #ddd; border-bottom: 1px solid #ddd; }
790#meta       { font-size: small; text-align: center;}
791</style>
792<link rel="alternate"
793  type="application/rdf+xml"
794  title="DOAP (Description Of A Project) profile for this site's software"
795  href="$script_name?action=about;format=rdf" />
796</head>
797<body>
798<div id="content">
799<div id="logo">
800<a href="http://openguides.org/"><img
801src="http://openguides.org/img/logo.jpg" alt="OpenGuides.org"></a>
802<h1><a href="$script_name">$site_name</a></h1>
803<h2>is powered by <a href="http://openguides.org/">OpenGuides</a> -<br>
804the guides built by you.</h2>
805<h3>version <a href="http://search.cpan.org/~dom/OpenGuides-$VERSION">$VERSION</a></h3>
806</div>
807<div id="about">
808<p>
809<a href="http://www.w3.org/RDF/"><img
810src="http://openguides.org/img/rdf_icon.png" width="44" height="48"
811style="float: right; margin-left: 10px; border: 0px"></a> OpenGuides is a
812web-based collaborative <a href="http://wiki.org/wiki.cgi?WhatIsWiki">wiki</a>
813environment for building guides and sharing information, as both
814human-readable text and <a href="http://www.w3.org/RDF/"><acronym
815title="Resource Description Framework">RDF</acronym></a>. The engine contains
816a number of geodata-specific metadata mechanisms such as locale search, node
817classification and integration with <a href="http://maps.google.com/">Google
818Maps</a>.
819</p>
820<p>
821OpenGuides is written in <a href="http://www.perl.org/">Perl</a>, and is
822made available under the same license as Perl itself (dual <a
823href="http://dev.perl.org/licenses/artistic.html" title='The "Artistic Licence"'>Artistic</a> and <a
824href="http://www.opensource.org/licenses/gpl-license.php"><acronym
825title="GNU Public Licence">GPL</acronym></a>). Developer information for the
826project is available from the <a href="http://dev.openguides.org/">OpenGuides
827development site</a>.
828</p>
829<p>
830Copyright &copy;2003-2006, <a href="http://openguides.org/">The OpenGuides
831Project</a>. "OpenGuides", "[The] Open Guide To..." and "The guides built by
832you" are trademarks of The OpenGuides Project. Any uses on this site are made
833with permission.
834</p>
835</div>
836<div id="meta">
837<a href="$script_name?action=about;format=rdf"><acronym
838title="Description Of A Project">DOAP</acronym> RDF version of this
839information</a>
840</div>
841</div>
842</body>
843</html>};
844    }
845   
846    return $output if $args{return_output};
847    print $output;
848}
849
850=item B<commit_node>
851
852  $guide->commit_node(
853                         id      => $node,
854                         cgi_obj => $q,
855                     );
856
857As with other methods, parameters C<return_tt_vars> and
858C<return_output> can be used to return these things instead of
859printing the output to STDOUT.
860
861The geographical data that you should provide in the L<CGI> object
862depends on the handler you chose in C<wiki.conf>.
863
864=over
865
866=item *
867
868B<British National Grid> - provide either C<os_x> and C<os_y> or
869C<latitude> and C<longitude>; whichever set of data you give, it will
870be converted to the other and both sets will be stored.
871
872=item *
873
874B<Irish National Grid> - provide either C<osie_x> and C<osie_y> or
875C<latitude> and C<longitude>; whichever set of data you give, it will
876be converted to the other and both sets will be stored.
877
878=item *
879
880B<UTM ellipsoid> - provide C<latitude> and C<longitude>; these will be
881converted to easting and northing and both sets of data will be stored.
882
883=back
884
885=cut
886
887sub commit_node {
888    my ($self, %args) = @_;
889    my $node = $args{id};
890    my $q = $args{cgi_obj};
891    my $return_output = $args{return_output};
892    my $wiki = $self->wiki;
893    my $config = $self->config;
894
895    my $content  = $q->param("content");
896    $content =~ s/\r\n/\n/gs;
897    my $checksum = $q->param("checksum");
898
899    my %metadata = OpenGuides::Template->extract_metadata_vars(
900        wiki    => $wiki,
901        config  => $config,
902    cgi_obj => $q
903    );
904
905    delete $metadata{website} if $metadata{website} eq 'http://';
906
907    $metadata{opening_hours_text} = $q->param("hours_text") || "";
908
909    # Pick out the unmunged versions of lat/long if they're set.
910    # (If they're not, it means they weren't munged in the first place.)
911    $metadata{latitude} = delete $metadata{latitude_unmunged}
912        if $metadata{latitude_unmunged};
913    $metadata{longitude} = delete $metadata{longitude_unmunged}
914        if $metadata{longitude_unmunged};
915
916    # Check to make sure all the indexable nodes are created
917    foreach my $type (qw(Category Locale)) {
918        my $lctype = lc($type);
919        foreach my $index (@{$metadata{$lctype}}) {
920            $index =~ s/(.*)/\u$1/;
921            my $node = $type . " " . $index;
922            # Uppercase the node name before checking for existence
923            $node =~ s/ (\S+)/ \u$1/g;
924            unless ( $wiki->node_exists($node) ) {
925                my $category = $type eq "Category" ? "Category" : "Locales";
926                $wiki->write_node(
927                                     $node,
928                                     "\@INDEX_LINK [[$node]]",
929                                     undef,
930                                     {
931                                         username => "Auto Create",
932                                         comment  => "Auto created $lctype stub page",
933                                         category => $category
934                                     }
935                                 );
936            }
937        }
938    }
939   
940    foreach my $var ( qw( summary username comment edit_type ) ) {
941        $metadata{$var} = $q->param($var) || "";
942    }
943    $metadata{host} = $ENV{REMOTE_ADDR};
944
945    # CGI::Wiki::Plugin::RSS::ModWiki wants "major_change" to be set.
946    $metadata{major_change} = ( $metadata{edit_type} eq "Normal edit" )
947                            ? 1
948                            : 0;
949
950    my $written = $wiki->write_node($node, $content, $checksum, \%metadata );
951
952    if ($written) {
953        my $output = $self->redirect_to_node($node);
954        return $output if $return_output;
955        print $output;
956    } else {
957        my %node_data = $wiki->retrieve_node($node);
958        my %tt_vars = ( checksum       => $node_data{checksum},
959                        new_content    => $content,
960                        stored_content => $node_data{content} );
961        foreach my $mdvar ( keys %metadata ) {
962            if ($mdvar eq "locales") {
963                $tt_vars{"stored_$mdvar"} = $node_data{metadata}{locale};
964                $tt_vars{"new_$mdvar"}    = $metadata{locale};
965            } elsif ($mdvar eq "categories") {
966                $tt_vars{"stored_$mdvar"} = $node_data{metadata}{category};
967                $tt_vars{"new_$mdvar"}    = $metadata{category};
968            } elsif ($mdvar eq "username" or $mdvar eq "comment"
969                      or $mdvar eq "edit_type" ) {
970                $tt_vars{$mdvar} = $metadata{$mdvar};
971            } else {
972                $tt_vars{"stored_$mdvar"} = $node_data{metadata}{$mdvar}[0];
973                $tt_vars{"new_$mdvar"}    = $metadata{$mdvar};
974            }
975        }
976        return %tt_vars if $args{return_tt_vars};
977        my $output = $self->process_template(
978                                              id       => $node,
979                                              template => "edit_conflict.tt",
980                                              tt_vars  => \%tt_vars,
981                                            );
982        return $output if $args{return_output};
983        print $output;
984    }
985}
986
987
988=item B<delete_node>
989
990  $guide->delete_node(
991                         id       => "FAQ",
992                         version  => 15,
993                         password => "beer",
994                     );
995
996C<version> is optional - if it isn't supplied then all versions of the
997node will be deleted; in other words the node will be entirely
998removed.
999
1000If C<password> is not supplied then a form for entering the password
1001will be displayed.
1002
1003As with other methods, parameters C<return_tt_vars> and
1004C<return_output> can be used to return these things instead of
1005printing the output to STDOUT.
1006
1007=cut
1008
1009sub delete_node {
1010    my ($self, %args) = @_;
1011    my $node = $args{id} or croak "No node ID supplied for deletion";
1012    my $return_tt_vars = $args{return_tt_vars} || 0;
1013    my $return_output = $args{return_output} || 0;
1014
1015    my %tt_vars = (
1016                      not_editable  => 1,
1017                      not_deletable => 1,
1018                      deter_robots  => 1,
1019                  );
1020    $tt_vars{delete_version} = $args{version} || "";
1021
1022    my $password = $args{password};
1023
1024    if ($password) {
1025        if ($password ne $self->config->admin_pass) {
1026            return %tt_vars if $return_tt_vars;
1027            my $output = $self->process_template(
1028                                                    id       => $node,
1029                                                    template => "delete_password_wrong.tt",
1030                                                    tt_vars  => \%tt_vars,
1031                                                );
1032            return $output if $return_output;
1033            print $output;
1034        } else {
1035            $self->wiki->delete_node(
1036                                        name    => $node,
1037                                        version => $args{version},
1038                                    );
1039            # Check whether any versions of this node remain.
1040            my %check = $self->wiki->retrieve_node( name => $node );
1041            $tt_vars{other_versions_remain} = 1 if $check{version};
1042            return %tt_vars if $return_tt_vars;
1043            my $output = $self->process_template(
1044                                                    id       => $node,
1045                                                    template => "delete_done.tt",
1046                                                    tt_vars  => \%tt_vars,
1047                                                );
1048            return $output if $return_output;
1049            print $output;
1050        }
1051    } else {
1052        return %tt_vars if $return_tt_vars;
1053        my $output = $self->process_template(
1054                                                id       => $node,
1055                                                template => "delete_confirm.tt",
1056                                                tt_vars  => \%tt_vars,
1057                                            );
1058        return $output if $return_output;
1059        print $output;
1060    }
1061}
1062
1063sub process_template {
1064    my ($self, %args) = @_;
1065    my %output_conf = (
1066                          wiki     => $self->wiki,
1067                          config   => $self->config,
1068                          node     => $args{id},
1069                          template => $args{template},
1070                          vars     => $args{tt_vars},
1071                          cookies  => $args{cookies},
1072                      );
1073    if ( $args{content_type} ) {
1074        $output_conf{content_type} = $args{content_type};
1075    }
1076    return OpenGuides::Template->output( %output_conf );
1077}
1078
1079sub redirect_to_node {
1080    my ($self, $node, $redirected_from) = @_;
1081   
1082    my $script_url = $self->config->script_url;
1083    my $script_name = $self->config->script_name;
1084    my $formatter = $self->wiki->formatter;
1085
1086    my $id = $formatter->node_name_to_node_param( $node );
1087    my $oldid;
1088    $oldid = $formatter->node_name_to_node_param( $redirected_from ) if $redirected_from;
1089
1090    my $redir_param = "$script_url$script_name?";
1091    $redir_param .= 'id=' if $oldid;
1092    $redir_param .= $id;
1093    $redir_param .= ";oldid=$oldid" if $oldid;
1094   
1095    my $q = CGI->new;
1096    return $q->redirect( $redir_param );
1097}
1098
1099sub get_cookie {
1100    my $self = shift;
1101    my $config = $self->config;
1102    my $pref_name = shift or return "";
1103    my %cookie_data = OpenGuides::CGI->get_prefs_from_cookie(config=>$config);
1104    return $cookie_data{$pref_name};
1105}
1106
1107
1108=head1 BUGS AND CAVEATS
1109
1110UTF8 data are currently not handled correctly throughout.
1111
1112Other bugs are documented at
1113L<http://dev.openguides.org/>
1114
1115=head1 SEE ALSO
1116
1117=over 4
1118
1119=item * L<http://london.openguides.org/|The Open Guide to London>, the first and biggest OpenGuides site.
1120
1121=item * L<http://openguides.org/|The OpenGuides website>, with a list of all live OpenGuides installs.
1122
1123=item * L<CGI::Wiki>, the Wiki toolkit which does the heavy lifting for OpenGuides
1124
1125=back
1126
1127=head1 FEEDBACK
1128
1129If you have a question, a bug report, or a patch, or you're interested
1130in joining the development team, please contact openguides-dev@openguides.org
1131(moderated mailing list, will reach all current developers but you'll have
1132to wait for your post to be approved) or file a bug report at
1133L<http://dev.openguides.org/>
1134
1135=head1 AUTHOR
1136
1137The OpenGuides Project (openguides-dev@openguides.org)
1138
1139=head1 COPYRIGHT
1140
1141     Copyright (C) 2003-2006 The OpenGuides Project.  All Rights Reserved.
1142
1143The OpenGuides distribution is free software; you can redistribute it
1144and/or modify it under the same terms as Perl itself.
1145
1146=head1 CREDITS
1147
1148Programming by Dominic Hargreaves, Earle Martin, Kake Pugh, and Ivor
1149Williams.  Testing and bug reporting by Billy Abbott, Jody Belka,
1150Kerry Bosworth, Simon Cozens, Cal Henderson, Steve Jolly, and Bob
1151Walker (among others).  Much of the Module::Build stuff copied from
1152the Siesta project L<http://siesta.unixbeard.net/>
1153
1154=cut
1155
11561;
Note: See TracBrowser for help on using the repository browser.