File Coverage

blib/lib/HTML/WikiConverter/SnipSnap.pm
Criterion Covered Total %
statement 9 33 27.2
branch 0 14 0.0
condition 0 4 0.0
subroutine 3 7 42.8
pod 0 1 0.0
total 12 59 20.3


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