File Coverage

blib/lib/HTML/WikiConverter/UseMod.pm
Criterion Covered Total %
statement 9 35 25.7
branch 0 16 0.0
condition 0 12 0.0
subroutine 3 8 37.5
pod 0 2 0.0
total 12 73 16.4


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