File Coverage

blib/lib/CGI/Wiki/Formatter/UseMod.pm
Criterion Covered Total %
statement 16 18 88.8
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 22 24 91.6


","");
line stmt bran cond sub pod time code
1             package CGI::Wiki::Formatter::UseMod;
2              
3 12     12   285090 use strict;
  12         28  
  12         650  
4              
5 12     12   73 use vars qw( $VERSION @_links_found );
  12         19  
  12         973  
6             $VERSION = '0.18';
7              
8 12     12   16199 use URI::Escape;
  12         40758  
  12         1059  
9 12     12   13555 use Text::WikiFormat as => 'wikiformat';
  12         1028746  
  12         103  
10 12     12   19196 use HTML::PullParser;
  12         161928  
  12         590  
11 12     12   23412 use URI::Find::Delimited;
  0            
  0            
12              
13             =head1 NAME
14              
15             CGI::Wiki::Formatter::UseMod - UseModWiki-style formatting for CGI::Wiki
16              
17             =head1 DESCRIPTION
18              
19             A formatter backend for L that supports UseMod-style formatting.
20              
21             =head1 SYNOPSIS
22              
23             use CGI::Wiki::Formatter::UseMod;
24              
25             # Instantiate - see below for parameter details.
26             my $formatter = CGI::Wiki::Formatter::UseMod->new( %config );
27              
28             # Format some text.
29             my $cooked = $formatter->format($raw);
30              
31             # Find out which other nodes that text would link to.
32             my @links_to = $formatter->find_internal_links($raw);
33              
34             =head1 METHODS
35              
36             =over 4
37              
38             =item B
39              
40             my $formatter = CGI::Wiki::Formatter::UseMod->new(
41             extended_links => 0, # $FreeLinks
42             implicit_links => 1, # $WikiLinks
43             force_ucfirst_nodes => 1, # $FreeUpper
44             use_headings => 1, # $UseHeadings
45             allowed_tags => [qw(b i)], # defaults to none
46             macros => {},
47             pass_wiki_to_macros => 0,
48             node_prefix => 'wiki.pl?',
49             node_suffix => '',
50             edit_prefix => 'wiki.pl?action=edit;id=',
51             edit_suffix => '',
52             munge_urls => 0,
53             );
54              
55             Parameters will default to the values shown above (apart from
56             C, which defaults to allowing no tags).
57              
58             =over 4
59              
60             =item B
61              
62             C, C, C and C
63             allow you to control the URLs generated for links to other wiki pages.
64             So for example with the defaults given above, a link to the Home node
65             will have the URL C and a link to the edit form for the
66             Home node will have the URL C
67              
68             (Note that of course the URLs that you wish to have generated will
69             depend on how your wiki application processes its CGI parameters - you
70             can't just put random stuff in there and hope it works!)
71              
72             =item B
73              
74             If you wish to have greater control over the links, you may use the
75             C parameter. The value of this should be a
76             subroutine reference. This sub will be called on each internal link
77             after all other formatting and munging I URL escaping has been
78             applied. It will be passed the node name as its first parameter and
79             should return a node name. Note that this will affect the URLs of
80             internal links, but not the link text.
81              
82             Example:
83              
84             # The formatter munges links so node names are ucfirst.
85             # Ensure 'state51' always appears in lower case in node names.
86             munge_node_name => sub {
87             my $node_name = shift;
88             $node_name =~ s/State51/state51/g;
89             return $node_name;
90             }
91              
92             B This is I usage and you should only do it if you
93             I know what you're doing. Consider in particular whether and
94             how your munged nodes are going to be treated by C.
95              
96             =item B
97              
98             If you set C to true, then your URLs will be more
99             user-friendly, for example
100              
101             http://example.com/wiki.cgi?Mailing_List_Managers
102              
103             rather than
104              
105             http://example.com/wiki.cgi?Mailing%20List%20Managers
106              
107             The former behaviour is the actual UseMod behaviour, but requires a
108             little fiddling about in your code (see C),
109             so the default is to B munge URLs.
110              
111             =item B
112              
113             Be aware that macros are processed I filtering out disallowed
114             HTML tags and I transforming from wiki markup into HTML. They
115             are also not called in any particular order.
116              
117             The keys of macros should be either regexes or strings. The values can
118             be strings, or, if the corresponding key is a regex, can be coderefs.
119             The coderef will be called with the first nine substrings captured by
120             the regex as arguments. I would like to call it with all captured
121             substrings but apparently this is complicated.
122              
123             You may wish to have access to the overall wiki object in the subs
124             defined in your macro. To do this:
125              
126             =over
127              
128             =item *
129              
130             Pass the wiki object to the C<< ->formatter >> call as described below.
131              
132             =item *
133              
134             Pass a true value in the C parameter when calling
135             C<< ->new >>.
136              
137             =back
138              
139             If you do this, then I coderefs will be called with the wiki object
140             as the first parameter, followed by the first nine captured substrings
141             as described above. Note therefore that setting C
142             may cause backwards compatibility issues.
143              
144             =back
145              
146             Macro examples:
147              
148             # Simple example - substitute a little search box for '@SEARCHBOX'
149              
150             macros => {
151              
152             '@SEARCHBOX' =>
153             qq(
154            
155            
156             ),
157             }
158              
159             # More complex example - substitute a list of all nodes in a
160             # category for '@INDEX_LINK [[Category Foo]]'
161              
162             pass_wiki_to_macros => 1,
163             macros => {
164             qr/\@INDEX_LINK\s+\[\[Category\s+([^\]]+)]]/ =>
165             sub {
166             my ($wiki, $category) = @_;
167             my @nodes = $wiki->list_nodes_by_metadata(
168             metadata_type => "category",
169             metadata_value => $category,
170             ignore_case => 1,
171             );
172             my $return = "\n";
173             foreach my $node ( @nodes ) {
174             $return .= "* "
175             . $wiki->formatter->format_link(
176             wiki => $wiki,
177             link => $node,
178             )
179             . "\n";
180             }
181             return $return;
182             },
183             }
184              
185              
186             =cut
187              
188             sub new {
189             my ($class, @args) = @_;
190             my $self = {};
191             bless $self, $class;
192             $self->_init(@args) or return undef;
193             return $self;
194             }
195              
196             sub _init {
197             my ($self, %args) = @_;
198              
199             # Store the parameters or their defaults.
200             my %defs = ( extended_links => 0,
201             implicit_links => 1,
202             force_ucfirst_nodes => 1,
203             use_headings => 1,
204             allowed_tags => [],
205             macros => {},
206             pass_wiki_to_macros => 0,
207             node_prefix => 'wiki.pl?',
208             node_suffix => '',
209             edit_prefix => 'wiki.pl?action=edit;id=',
210             edit_suffix => '',
211             munge_urls => 0,
212             munge_node_name => undef,
213             );
214              
215             my %collated = (%defs, %args);
216             foreach my $k (keys %defs) {
217             $self->{"_".$k} = $collated{$k};
218             }
219             return $self;
220             }
221              
222             =item B
223              
224             my $html = $formatter->format($submitted_content, $wiki);
225              
226             Escapes any tags which weren't specified as allowed on creation, then
227             interpolates any macros, then translates the raw Wiki language
228             supplied into HTML.
229              
230             A L object can be supplied as an optional second parameter.
231             This object will be used to determine whether a linked-to node exists
232             or not, and alter the presentation of the link accordingly. This is
233             only really in here for use when this method is being called from
234             within L.
235              
236             =cut
237              
238             sub format {
239             my ($self, $raw, $wiki) = @_;
240             $raw =~ s/\r\n/\n/sg; # CGI newline is \r\n not \n
241             my $safe = "";
242              
243             my %allowed = map {lc($_) => 1, "/".lc($_) => 1} @{$self->{_allowed_tags}};
244              
245             # Parse the HTML - even if we're not allowing any tags, because we're
246             # using a custom escaping routine rather than CGI.pm
247             my $parser = HTML::PullParser->new(doc => $raw,
248             start => '"TAG", tag, text',
249             end => '"TAG", tag, text',
250             text => '"TEXT", tag, text');
251             while (my $token = $parser->get_token) {
252             my ($flag, $tag, $text) = @$token;
253             if ($flag eq "TAG" and !defined $allowed{lc($tag)}) {
254             $safe .= $self->_escape_HTML($text);
255             } else {
256             $safe .= $text;
257             }
258             }
259              
260             # Now do any inline links.
261             my $callback = sub {
262             my ($open, $close, $url, $title, $whitespace) = @_;
263             $title ||= $url;
264             if ( $open && $close ) {
265             return $self->make_external_link( title => $title, url => $url );
266             } else {
267             return $open
268             . $self->make_external_link( title => $title, url => $url )
269             . $close;
270             }
271             };
272            
273             my $finder = URI::Find::Delimited->new( ignore_quoted => 1, callback => $callback );
274             $finder->find(\$safe);
275              
276             # Now process any macros.
277             my %macros = %{$self->{_macros}};
278             foreach my $key (keys %macros) {
279             my $value = $macros{$key};
280             if ( ref $value && ref $value eq 'CODE' ) {
281             if ( $self->{_pass_wiki_to_macros} and $wiki ) {
282             $safe=~ s/$key/$value->($wiki, $1, $2, $3, $4, $5, $6, $7, $8, $9)/eg;
283             } else {
284             $safe=~ s/$key/$value->($1, $2, $3, $4, $5, $6, $7, $8, $9)/eg;
285             }
286             } else {
287             $safe =~ s/$key/$value/g;
288             }
289             }
290              
291             # Finally set up config and call Text::WikiFormat.
292             my %format_opts = $self->_format_opts;
293             my %format_tags = (
294             # chromatic made most of the regex below. I will document it when
295             # I understand it properly.
296             indent => qr/^(?:\t+|\s{4,}|\s*\*?(?=\**\*+))/,
297             newline => "", # avoid bogus
298             paragraph => [ "

", "

\n", "", "\n", 1 ], # no bogus
299             extended_link_delimiters => [ '[[', ']]' ],
300             blocks => {
301             ordered => qr/^\s*([\d]+)\.\s*/,
302             unordered => qr/^\s*\*\s*/,
303             definition => qr/^:\s*/,
304             pre => qr/^\s+/,
305             table => qr/^\|\|/,
306             },
307             definition => [ "
\n", "
\n", "
 ", "
\n" ],
308             pre => [ "
\n", "
\n", "", "\n" ],
309             table => [ qq|\n|, "
\n",
310             sub {
311             my $line = shift;
312             $line =~ s/\|\|$/<\/td>/;
313             $line =~ s/\|\|/<\/td>/g;
314             return ("
$line","
315             },
316             ],
317             # we don't label unordered lists as "not indented" so we can nest them.
318             indented => {
319             definition => 0,
320             ordered => 0,
321             pre => 0,
322             table => 0,
323             },
324             blockorder => [ qw( header line ordered unordered code definition pre table paragraph )],
325             nests => { map { $_ => 1} qw( ordered unordered ) },
326             link => sub {
327             my $link = shift;
328             return $self->format_link(
329             link => $link,
330             wiki => $wiki,
331             );
332             },
333             );
334              
335             return wikiformat($safe, \%format_tags, \%format_opts );
336             }
337              
338             sub _format_opts {
339             my $self = shift;
340             return (
341             extended => $self->{_extended_links},
342             prefix => $self->{_node_prefix},
343             implicit_links => $self->{_implicit_links}
344             );
345             }
346              
347             =item B
348              
349             my $string = $formatter->format_link(
350             link => "Home Node",
351             wiki => $wiki,
352             );
353              
354             An internal method exposed to make it easy to go from eg
355              
356             * Foo
357             * Bar
358              
359             to
360              
361             * Foo
362             * Bar
363              
364             See Macro Examples above for why you might find this useful.
365              
366             C should be something that would go inside your extended link
367             delimiters. C is optional but should be a L object.
368             If you do supply C then the method will be able to check whether
369             the node exists yet or not and so will call C<< ->make_edit_link >>
370             instead of C<< ->make_internal_link >> where appropriate. If you don't
371             supply C then C<< ->make_internal_link >> will be called always.
372              
373             This method used to be private so may do unexpected things if you use
374             it in a way that I haven't tested yet.
375              
376             =cut
377              
378             sub format_link {
379             my ($self, %args) = @_;
380             my $link = $args{link};
381             my %opts = $self->_format_opts;
382             my $wiki = $args{wiki};
383              
384             my $title;
385             ($link, $title) = split(/\|/, $link, 2) if $opts{extended};
386             $title =~ s/^\s*// if $title; # strip leading whitespace
387             $title ||= $link;
388              
389             if ( $self->{_force_ucfirst_nodes} ) {
390             $link = $self->_do_freeupper($link);
391             }
392             $link = $self->_munge_spaces($link);
393              
394             $link = $self->{_munge_node_name}($link)
395             if $self->{_munge_node_name};
396              
397             my $editlink_not_link = 0;
398             # See whether the linked-to node exists, if we can.
399             if ( $wiki && !$wiki->node_exists( $link ) ) {
400             $editlink_not_link = 1;
401             }
402              
403             $link =~ s/ /_/g if $self->{_munge_urls};
404             $link = uri_escape( $link );
405              
406             if ( $editlink_not_link ) {
407             my $prefix = $self->{_edit_prefix};
408             my $suffix = $self->{_edit_suffix};
409             return $self->make_edit_link(
410             title => $title,
411             url => $prefix.$link.$suffix,
412             );
413             } else {
414             my $prefix = $self->{_node_prefix};
415             my $suffix = $self->{_node_suffix};
416             return $self->make_internal_link(
417             title => $title,
418             url => $prefix.$link.$suffix,
419             );
420             }
421             }
422              
423             # CGI.pm is sometimes awkward about actually performing CGI::escapeHTML
424             # if there's a previous instantiation - in the calling script, for example.
425             # So just do it here.
426             sub _escape_HTML {
427             my ($self, $text) = @_;
428             $text =~ s{&}{&}gso;
429             $text =~ s{<}{<}gso;
430             $text =~ s{>}{>}gso;
431             $text =~ s{"}{"}gso;
432             return $text;
433             }
434              
435             =item B
436            
437             my @links_to = $formatter->find_internal_links( $content );
438            
439             Returns a list of all nodes that the supplied content links to.
440            
441             =cut
442            
443             sub find_internal_links {
444             my ($self, $raw) = @_;
445            
446             @_links_found = ();
447            
448             my %format_opts = $self->_format_opts;
449              
450             my %format_tags = ( extended_link_delimiters => [ '[[', ']]' ],
451             link => sub {
452             my $link = shift;
453             my %opts = $self->_format_opts;
454             my $title;
455             ($link, $title) = split(/\|/, $link, 2)
456             if $opts{extended};
457             if ( $self->{_force_ucfirst_nodes} ) {
458             $link = $self->_do_freeupper($link);
459             }
460             $link = $self->{_munge_node_name}($link)
461             if $self->{_munge_node_name};
462             $link = $self->_munge_spaces($link);
463             push @CGI::Wiki::Formatter::UseMod::_links_found,
464             $link;
465             return ""; # don't care about output
466             }
467             );
468              
469             my $foo = wikiformat($raw, \%format_tags, \%format_opts);
470              
471             my @links = @_links_found;
472             @_links_found = ();
473             return @links;
474             }
475              
476              
477             =item B
478              
479             use URI::Escape;
480             $param = $formatter->node_name_to_node_param( "Recent Changes" );
481             my $url = "wiki.pl?" . uri_escape($param);
482              
483             In usemod, the node name is encoded prior to being used as part of the
484             URL. This method does this encoding (essentially, whitespace is munged
485             into underscores). In addition, if C is in action
486             then the node names will be forced ucfirst if they weren't already.
487              
488             Note that unless C was set to true when C was called,
489             this method will do nothing.
490              
491             =cut
492              
493             sub node_name_to_node_param {
494             my ($self, $node_name) = @_;
495             return $node_name unless $self->{_munge_urls};
496             my $param = $node_name;
497             $param = $self->_munge_spaces($param);
498             $param = $self->_do_freeupper($param) if $self->{_force_ucfirst_nodes};
499             $param =~ s/ /_/g;
500              
501             return $param;
502             }
503              
504             =item B
505              
506             my $node = $q->param('node') || "";
507             $node = $formatter->node_param_to_node_name( $node );
508              
509             In usemod, the node name is encoded prior to being used as part of the
510             URL, so we must decode it before we can get back the original node name.
511              
512             Note that unless C was set to true when C was called,
513             this method will do nothing.
514              
515             =cut
516              
517             sub node_param_to_node_name {
518             my ($self, $param) = @_;
519             return $param unless $self->{_munge_urls};
520              
521             # Note that this might not give us back exactly what we started with,
522             # since in the encoding we collapse and trim whitespace; but this is
523             # how usemod does it (as of 0.92) and usemod is what we're emulating.
524             $param =~ s/_/ /g;
525              
526             return $param;
527             }
528              
529             sub _do_freeupper {
530             my ($self, $node) = @_;
531              
532             # This is the FreeUpper usemod behaviour, slightly modified from
533             # their regexp, as we need to do it before we check whether the
534             # node exists ie before we substitute the spaces with underscores.
535             $node = ucfirst($node);
536             $node =~ s|([- _.,\(\)/])([a-z])|$1.uc($2)|ge;
537              
538             return $node;
539             }
540              
541             sub _munge_spaces {
542             my ($self, $node) = @_;
543              
544             # Yes, we really do only munge spaces, not all whitespace. This is
545             # how usemod does it (as of 0.92).
546             $node =~ s/ +/ /g;
547             $node =~ s/^ //;
548             $node =~ s/ $//;
549              
550             return $node
551             }
552              
553             =head1 SUBCLASSING
554              
555             The following methods can be overridden to provide custom behaviour.
556              
557             =over
558              
559             =item B
560              
561             my $link = $self->make_edit_link(
562             title => "Home Page",
563             url => "http://example.com/?id=Home",
564             );
565              
566             This method will be passed a title and a url and should return an HTML
567             snippet. For example, you can add a C attribute to the link </td> </tr> <tr> <td class="h" > <a name="568">568</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> like so: </td> </tr> <tr> <td class="h" > <a name="569">569</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="570">570</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub make_edit_link { </td> </tr> <tr> <td class="h" > <a name="571">571</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my ($self, %args) = @_; </td> </tr> <tr> <td class="h" > <a name="572">572</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $title = $args{title}; </td> </tr> <tr> <td class="h" > <a name="573">573</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $url = $args{url}; </td> </tr> <tr> <td class="h" > <a name="574">574</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> return qq|[$title]<a href="$url" title="create">?</a>|; </td> </tr> <tr> <td class="h" > <a name="575">575</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="576">576</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="577">577</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =cut </td> </tr> <tr> <td class="h" > <a name="578">578</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="579">579</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub make_edit_link { </td> </tr> <tr> <td class="h" > <a name="580">580</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my ($self, %args) = @_; </td> </tr> <tr> <td class="h" > <a name="581">581</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> return qq|[$args{title}]<a href="$args{url}">?</a>|; </td> </tr> <tr> <td class="h" > <a name="582">582</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="583">583</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="584">584</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =item B<make_internal_link> </td> </tr> <tr> <td class="h" > <a name="585">585</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="586">586</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $link = $self->make_internal_link( </td> </tr> <tr> <td class="h" > <a name="587">587</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> title => "Home Page", </td> </tr> <tr> <td class="h" > <a name="588">588</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> url => "http://example.com/?id=Home", </td> </tr> <tr> <td class="h" > <a name="589">589</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ); </td> </tr> <tr> <td class="h" > <a name="590">590</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="591">591</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> This method will be passed a title and a url and should return an HTML </td> </tr> <tr> <td class="h" > <a name="592">592</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> snippet. For example, you can add a C<class> attribute to the link </td> </tr> <tr> <td class="h" > <a name="593">593</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> like so: </td> </tr> <tr> <td class="h" > <a name="594">594</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="595">595</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub make_internal_link { </td> </tr> <tr> <td class="h" > <a name="596">596</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my ($self, %args) = @_; </td> </tr> <tr> <td class="h" > <a name="597">597</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $title = $args{title}; </td> </tr> <tr> <td class="h" > <a name="598">598</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $url = $args{url}; </td> </tr> <tr> <td class="h" > <a name="599">599</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> return qq|<a href="$url" class="internal">$title</a>|; </td> </tr> <tr> <td class="h" > <a name="600">600</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="601">601</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="602">602</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =cut </td> </tr> <tr> <td class="h" > <a name="603">603</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="604">604</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub make_internal_link { </td> </tr> <tr> <td class="h" > <a name="605">605</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my ($self, %args) = @_; </td> </tr> <tr> <td class="h" > <a name="606">606</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> return qq|<a href="$args{url}">$args{title}</a>|; </td> </tr> <tr> <td class="h" > <a name="607">607</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="608">608</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="609">609</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =item B<make_external_link> </td> </tr> <tr> <td class="h" > <a name="610">610</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="611">611</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $link = $self->make_external_link( </td> </tr> <tr> <td class="h" > <a name="612">612</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> title => "London Perlmongers", </td> </tr> <tr> <td class="h" > <a name="613">613</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> url => "http://london.pm.org", </td> </tr> <tr> <td class="h" > <a name="614">614</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ); </td> </tr> <tr> <td class="h" > <a name="615">615</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="616">616</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> This method will be passed a title and a url and should return an HTML </td> </tr> <tr> <td class="h" > <a name="617">617</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> snippet. For example, you can add a little icon after each external </td> </tr> <tr> <td class="h" > <a name="618">618</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> link like so: </td> </tr> <tr> <td class="h" > <a name="619">619</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="620">620</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub make_external_link { </td> </tr> <tr> <td class="h" > <a name="621">621</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my ($self, %args) = @_; </td> </tr> <tr> <td class="h" > <a name="622">622</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $title = $args{title}; </td> </tr> <tr> <td class="h" > <a name="623">623</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $url = $args{url}; </td> </tr> <tr> <td class="h" > <a name="624">624</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> return qq|<a href="$url">$title</a> <img src="external.gif">|; </td> </tr> <tr> <td class="h" > <a name="625">625</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="626">626</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="627">627</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =cut </td> </tr> <tr> <td class="h" > <a name="628">628</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="629">629</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub make_external_link { </td> </tr> <tr> <td class="h" > <a name="630">630</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my ($self, %args) = @_; </td> </tr> <tr> <td class="h" > <a name="631">631</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my ($open, $close) = ( "[", "]" ); </td> </tr> <tr> <td class="h" > <a name="632">632</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ( $args{title} eq $args{url} ) { </td> </tr> <tr> <td class="h" > <a name="633">633</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ($open, $close) = ( "", "" ); </td> </tr> <tr> <td class="h" > <a name="634">634</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="635">635</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> return qq|$open<a href="$args{url}">$args{title}</a>$close|; </td> </tr> <tr> <td class="h" > <a name="636">636</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="637">637</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="638">638</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =back </td> </tr> <tr> <td class="h" > <a name="639">639</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="640">640</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =head1 AUTHOR </td> </tr> <tr> <td class="h" > <a name="641">641</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="642">642</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Kake Pugh (kake@earth.li). </td> </tr> <tr> <td class="h" > <a name="643">643</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="644">644</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =head1 COPYRIGHT </td> </tr> <tr> <td class="h" > <a name="645">645</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="646">646</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Copyright (C) 2003-2004 Kake Pugh. All Rights Reserved. </td> </tr> <tr> <td class="h" > <a name="647">647</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="648">648</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> This module is free software; you can redistribute it and/or modify it </td> </tr> <tr> <td class="h" > <a name="649">649</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> under the same terms as Perl itself. </td> </tr> <tr> <td class="h" > <a name="650">650</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="651">651</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =head1 CREDITS </td> </tr> <tr> <td class="h" > <a name="652">652</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="653">653</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> The OpenGuides London team (L<http://openguides.org/london/>) sent </td> </tr> <tr> <td class="h" > <a name="654">654</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> some very helpful bug reports. A lot of the work of this module is </td> </tr> <tr> <td class="h" > <a name="655">655</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> done within chromatic's module, L<Text::WikiFormat>. </td> </tr> <tr> <td class="h" > <a name="656">656</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="657">657</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =head1 CAVEATS </td> </tr> <tr> <td class="h" > <a name="658">658</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="659">659</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> This doesn't yet support all of UseMod's formatting features and </td> </tr> <tr> <td class="h" > <a name="660">660</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> options, by any means. This really truly I<is> a 0.* release. Please </td> </tr> <tr> <td class="h" > <a name="661">661</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> send bug reports, omissions, patches, and stuff, to me at </td> </tr> <tr> <td class="h" > <a name="662">662</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> C<kake@earth.li>. </td> </tr> <tr> <td class="h" > <a name="663">663</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="664">664</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =head1 NOTE ON USEMOD COMPATIBILITY </td> </tr> <tr> <td class="h" > <a name="665">665</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="666">666</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> UseModWiki "encodes" node names before making them part of a URL, so </td> </tr> <tr> <td class="h" > <a name="667">667</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> for example a node about Wombat Defenestration will have a URL like </td> </tr> <tr> <td class="h" > <a name="668">668</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="669">669</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> http://example.com/wiki.cgi?Wombat_Defenestration </td> </tr> <tr> <td class="h" > <a name="670">670</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="671">671</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> So if we want to emulate a UseModWiki exactly, we need to munge back </td> </tr> <tr> <td class="h" > <a name="672">672</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> and forth between node names as titles, and node names as CGI params. </td> </tr> <tr> <td class="h" > <a name="673">673</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="674">674</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $formatter = CGI::Wiki::Formatter::UseMod->new( munge_urls => 1 ); </td> </tr> <tr> <td class="h" > <a name="675">675</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $node_param = $q->param('id') || $q->param('keywords') || ""; </td> </tr> <tr> <td class="h" > <a name="676">676</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $node_name = $formatter->node_param_to_node_name( $node_param ); </td> </tr> <tr> <td class="h" > <a name="677">677</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="678">678</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> use URI::Escape; </td> </tr> <tr> <td class="h" > <a name="679">679</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $url = "http://example.com/wiki.cgi?" </td> </tr> <tr> <td class="h" > <a name="680">680</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> . uri_escape( </td> </tr> <tr> <td class="h" > <a name="681">681</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $formatter->node_name_to_node_param( "Wombat Defenestration" ) </td> </tr> <tr> <td class="h" > <a name="682">682</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ); </td> </tr> <tr> <td class="h" > <a name="683">683</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="684">684</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =head1 SEE ALSO </td> </tr> <tr> <td class="h" > <a name="685">685</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="686">686</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =over 4 </td> </tr> <tr> <td class="h" > <a name="687">687</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="688">688</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =item * L<CGI::Wiki> </td> </tr> <tr> <td class="h" > <a name="689">689</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="690">690</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =item * L<Text::WikiFormat> </td> </tr> <tr> <td class="h" > <a name="691">691</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="692">692</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =item * UseModWiki (L<http://www.usemod.com/cgi-bin/wiki.pl>) </td> </tr> <tr> <td class="h" > <a name="693">693</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="694">694</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =back </td> </tr> <tr> <td class="h" > <a name="695">695</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="696">696</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =cut </td> </tr> <tr> <td class="h" > <a name="697">697</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="698">698</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> 1; </td> </tr> </table> </body> </html>