File Coverage

blib/lib/Wiki/Toolkit/Formatter/WikiLinkFormatterParent.pm
Criterion Covered Total %
statement 21 35 60.0
branch 2 8 25.0
condition 1 2 50.0
subroutine 5 7 71.4
pod 2 3 66.6
total 31 55 56.3


line stmt bran cond sub pod time code
1             package Wiki::Toolkit::Formatter::WikiLinkFormatterParent;
2              
3 3     3   20 use strict;
  3         7  
  3         106  
4              
5 3     3   17 use vars qw( $VERSION @_links_found );
  3         22  
  3         188  
6             $VERSION = '0.01';
7              
8 3     3   2052 use Text::WikiFormat as => 'wikiformat';
  3         32328  
  3         20  
9              
10             =head1 NAME
11              
12             Wiki::Toolkit::Formatter::WikiLinkFormatterParent - The parent of Wiki::Toolkit formatters that work with Wiki Links.
13              
14             =head1 DESCRIPTION
15              
16             A provider of common formatter methods for L formatters that
17             deal with Wiki Links.
18              
19             =cut
20              
21             sub new {
22 0     0 0 0 my ($class, @args) = @_;
23 0         0 my $self = {};
24 0         0 bless $self, $class;
25 0 0       0 $self->_init(@args) or return undef;
26 0         0 return $self;
27             }
28              
29             =head1 METHODS
30              
31             =head2 C
32              
33             $formatter->rename_links( $from, $to, $content );
34              
35             Renames all the links to a certain page in the supplied content.
36             (Obviously this is dependent on object properties such as
37             C and C.)
38              
39             =cut
40              
41             sub rename_links {
42 0     0 1 0 my ($self, $from, $to, $content) = @_;
43              
44             # If we support extended (square bracket) links, update those
45 0 0       0 if($self->{_extended_links}) {
46 0         0 $content =~ s/\[$from\]/\[$to\]/g;
47 0         0 $content =~ s/\[$from(\s*|.*?)\]/\[$to$1\]/g;
48             }
49              
50             # If we support implicit (camelcase) links, update those
51 0 0       0 if($self->{_implicit_links}) {
52 0         0 $content =~ s/\b$from\b/$to/g;
53 0         0 $content =~ s/^$from\b/$to/gm;
54 0         0 $content =~ s/\b$from$/$to/gm;
55             }
56              
57 0         0 return $content;
58             }
59              
60             =head2 C
61              
62             my @links_to = $formatter->find_internal_links( $content );
63              
64             Returns a list of all nodes that the supplied content links to.
65             (Obviously this is dependent on object properties such as
66             C and C.)
67              
68             =cut
69              
70             sub find_internal_links {
71 3     3 1 22 my ($self, $raw) = @_;
72              
73 3         8 @_links_found = ();
74              
75             my $foo = wikiformat($raw,
76             { link => sub {
77 4     4   1566 my ($link, $opts) = @_;
78 4   50     12 $opts ||= {};
79 4         9 my $title;
80             ($link, $title) = split(/\|/, $link, 2)
81 4 100       16 if $opts->{extended};
82 4         10 push @Wiki::Toolkit::Formatter::WikiLinkFormatterParent::_links_found,
83             $link;
84 4         13 return ""; # don't care about output
85             }
86             },
87             {
88             extended => $self->{_extended_links},
89             prefix => $self->{_node_prefix},
90             implicit_links => $self->{_implicit_links}
91             }
92 3         29 );
93              
94 3         744 my @links = @_links_found;
95 3         7 @_links_found = ();
96 3         12 return @links;
97             }
98              
99             =head1 SEE ALSO
100              
101             L
102              
103             =head1 AUTHOR
104              
105             Kake Pugh (kake@earth.li).
106              
107             =head1 COPYRIGHT
108              
109             Copyright (C) 2002-2003 Kake Pugh. All Rights Reserved.
110             Copyright (C) 2006-2009 the Wiki::Toolkit team. All Rights Reserved.
111              
112             This module is free software; you can redistribute it and/or modify it
113             under the same terms as Perl itself.
114              
115             =cut
116              
117             1;