File Coverage

blib/lib/HTML/WikiConverter/Kwiki.pm
Criterion Covered Total %
statement 9 33 27.2
branch 0 18 0.0
condition 0 9 0.0
subroutine 3 8 37.5
pod 0 2 0.0
total 12 70 17.1


line stmt bran cond sub pod time code
1             package HTML::WikiConverter::Kwiki;
2              
3 1     1   20911 use warnings;
  1         3  
  1         39  
4 1     1   5 use strict;
  1         3  
  1         34  
5              
6 1     1   5 use base 'HTML::WikiConverter';
  1         11  
  1         1139  
7              
8             our $VERSION = '0.51';
9              
10             =head1 NAME
11              
12             HTML::WikiConverter::Kwiki - Convert HTML to Kwiki markup
13              
14             =head1 SYNOPSIS
15              
16             use HTML::WikiConverter;
17             my $wc = new HTML::WikiConverter( dialect => 'Kwiki' );
18             print $wc->html2wiki( $html );
19              
20             =head1 DESCRIPTION
21              
22             This module contains rules for converting HTML into Kwiki markup. See
23             L for additional usage details.
24              
25             =cut
26              
27             sub rules {
28 0     0 0   my %rules = (
29             hr => { replace => "\n----\n" },
30             br => { replace => "\n" },
31              
32             h1 => { start => '= ', block => 1, trim => 'both', line_format => 'single' },
33             h2 => { start => '== ', block => 1, trim => 'both', line_format => 'single' },
34             h3 => { start => '=== ', block => 1, trim => 'both', line_format => 'single' },
35             h4 => { start => '==== ', block => 1, trim => 'both', line_format => 'single' },
36             h5 => { start => '===== ', block => 1, trim => 'both', line_format => 'single' },
37             h6 => { start => '====== ', block => 1, trim => 'both', line_format => 'single' },
38              
39             p => { block => 1, trim => 'both', line_format => 'multi' },
40             b => { start => '*', end => '*', line_format => 'single' },
41             strong => { alias => 'b' },
42             i => { start => '/', end => '/', line_format => 'single' },
43             em => { alias => 'i' },
44             u => { start => '_', end => '_', line_format => 'single' },
45             strike => { start => '-', end => '-', line_format => 'single' },
46             s => { alias => 'strike' },
47              
48             tt => { start => '[=', end => ']', trim => 'both', line_format => 'single' },
49             code => { alias => 'tt' },
50             pre => { line_prefix => ' ', block => 1 },
51              
52             a => { replace => \&_link },
53             img => { replace => \&_image },
54              
55             table => { block => 1 },
56             tr => { end => " |\n", line_format => 'single' },
57             td => { start => '| ', end => ' ' },
58             th => { alias => 'td' },
59              
60             ul => { line_format => 'multi', block => 1 },
61             ol => { alias => 'ul' },
62             li => { start => \&_li_start, trim => 'leading' },
63             );
64              
65 0           return \%rules;
66             }
67              
68             sub _li_start {
69 0     0     my( $self, $node, $rules ) = @_;
70 0           my @parent_lists = $node->look_up( _tag => qr/ul|ol/ );
71 0           my $depth = @parent_lists;
72              
73 0           my $bullet = '';
74 0 0         $bullet = '*' if $node->parent->tag eq 'ul';
75 0 0         $bullet = '0' if $node->parent->tag eq 'ol';
76              
77 0           my $prefix = ( $bullet ) x $depth;
78 0           return "\n$prefix ";
79             }
80              
81             sub _link {
82 0     0     my( $self, $node, $rules ) = @_;
83 0   0       my $url = $node->attr('href') || '';
84 0   0       my $text = $self->get_elem_contents($node) || '';
85              
86 0 0         if( my $title = $self->get_wiki_page($url) ) {
87 0 0 0       return $title if $self->is_camel_case( $title ) and $text eq $title;
88 0 0         return "[$title]" if $text eq $title;
89 0 0         return "[$text http:?$title]" if $text ne $title;
90             } else {
91 0 0         return $url if $text eq $url;
92 0           return "[$text $url]";
93             }
94             }
95              
96             sub _image {
97 0     0     my( $self, $node, $rules ) = @_;
98 0   0       return $node->attr('src') || '';
99             }
100              
101             sub preprocess_node {
102 0     0 0   my( $self, $node ) = @_;
103 0 0         $self->strip_aname($node) if $node->tag eq 'a';
104 0 0         $self->caption2para($node) if $node->tag eq 'caption';
105             }
106              
107             =head1 AUTHOR
108              
109             David J. Iberri, C<< >>
110              
111             =head1 BUGS
112              
113             Please report any bugs or feature requests to
114             C, or through the web
115             interface at
116             L.
117             I will be notified, and then you'll automatically be notified of
118             progress on your bug as I make changes.
119              
120             =head1 SUPPORT
121              
122             You can find documentation for this module with the perldoc command.
123              
124             perldoc HTML::WikiConverter::Kwiki
125              
126             You can also look for information at:
127              
128             =over 4
129              
130             =item * AnnoCPAN: Annotated CPAN documentation
131              
132             L
133              
134             =item * CPAN Ratings
135              
136             L
137              
138             =item * RT: CPAN's request tracker
139              
140             L
141              
142             =item * Search CPAN
143              
144             L
145              
146             =back
147              
148             =head1 COPYRIGHT & LICENSE
149              
150             Copyright 2006 David J. Iberri, all rights reserved.
151              
152             This program is free software; you can redistribute it and/or modify
153             it under the same terms as Perl itself.
154              
155             =cut
156              
157             1;