Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Note moving to perl6 organization

  • Loading branch information...
commit 81a8cee0c0d9a992c391420cbf96d52a78a7487a 1 parent 2673c31
Tadeusz Sośnierz authored

Showing 3 changed files with 2 additions and 227 deletions. Show diff stats Hide diff stats

  1. +2 0  README
  2. +0 186 lib/Pod/To/HTML.pm
  3. +0 41 lib/Text/Escape.pm
2  README
... ... @@ -0,0 +1,2 @@
  1 +This repo has been moved to https://github.com/perl6/Pod-To-HTML
  2 +Please use that one instead of this one
186 lib/Pod/To/HTML.pm
... ... @@ -1,186 +0,0 @@
1   -module Pod::To::HTML;
2   -use Text::Escape;
3   -
4   -my $title;
5   -my @meta;
6   -my @indexes;
7   -my @body;
8   -
9   -sub pod2html($pod) is export {
10   - @body.push: whatever2html($pod);
11   -
12   - my $title_html = $title // 'Pod document';
13   -
14   - # TODO: make this look nice again when q:to"" gets implemented
15   - my $prelude = qq[<!doctype html>
16   -<html>
17   -<head>
18   - <title>{$title_html}</title>
19   - <meta charset="UTF-8" />
20   - <link rel="stylesheet" href="http://perlcabal.org/syn/perl.css">
21   - {metadata()}
22   -</head>
23   -<body class="pod" id="___top">
24   -];
25   -
26   - return $prelude
27   - ~ ($title.defined ?? "<h1>{$title_html}</h1>\n" !! '')
28   - ~ buildindexes()
29   - ~ @body.join
30   - ~ "</body>\n</html>";
31   -}
32   -
33   -sub whatever2html($node) {
34   - given $node {
35   - when Pod::Heading { heading2html($node) }
36   - when Pod::Block::Code { code2html($node) }
37   - when Pod::Block::Named { named2html($node) }
38   - when Pod::Block::Para { para2html($node) }
39   - when Pod::Block::Table { table2html($node) }
40   -# when Pod::Block::Declarator { declarator2html($node) }
41   - when Pod::Item { item2html($node) }
42   - when Positional { $node.map({whatever2html($_)}).join }
43   - when Pod::Block::Comment { }
44   - default { $node.Str }
45   - }
46   -}
47   -
48   -sub metadata {
49   - @meta.map(-> $p {
50   - qq[<meta name="{$p.key}" value="{$p.value}" />\n]
51   - }).join;
52   -}
53   -
54   -sub buildindexes {
55   - my $r = qq[<nav class="indexgroup">\n];
56   -
57   - my $indent = q{ } x 2;
58   - my @opened;
59   - for @indexes -> $p {
60   - my $lvl = $p.key;
61   - my %head = $p.value;
62   - if +@opened {
63   - while @opened[*-1] > $lvl {
64   - $r ~= $indent x @opened - 1
65   - ~ "</ul>\n";
66   - @opened.pop;
67   - }
68   - }
69   - my $last = @opened[*-1] // 0;
70   - if $last < $lvl {
71   - $r ~= $indent x $last
72   - ~ qq[<ul class="indexList indexList{$lvl}">\n];
73   - @opened.push($lvl);
74   - }
75   - $r ~= $indent x $lvl
76   - ~ qq[<li class="indexItem indexItem{$lvl}">]
77   - ~ qq[<a href="#{%head<uri>}">{%head<html>}</a>\n];
78   - }
79   - for ^@opened {
80   - $r ~= $indent x @opened - 1 - $^left
81   - ~ "</ul>\n";
82   - }
83   -
84   - return $r ~ "</nav>\n";
85   -}
86   -
87   -sub heading2html($pod) {
88   - my $lvl = min($pod.level, 6);
89   - my %escaped = ($_ => escape($pod.content[0].content, $_) for <uri html>);
90   - @indexes.push: Pair.new(key => $lvl, value => %escaped);
91   -
92   - return
93   - sprintf('<h%d id="%s">', $lvl, %escaped<uri>)
94   - ~ qq[<a class="u" href="#___top" title="go to top of document">]
95   - ~ %escaped<html>
96   - ~ qq[</a>]
97   - ~ qq[</h{$lvl}>\n];
98   -}
99   -
100   -sub named2html($pod) {
101   - given $pod.name {
102   - when 'pod' { whatever2html($pod.content) }
103   - when 'para' { para2html($pod.content[0]) }
104   - when 'defn' { whatever2html($pod.content[0]) ~ "\n"
105   - ~ whatever2html($pod.content[1..*-1]) }
106   - when 'config' { }
107   - when 'nested' { }
108   - default {
109   - if $pod.name eq 'TITLE' {
110   - $title = prose2html($pod.content[0]);
111   - }
112   - elsif $pod.name ~~ any(<VERSION DESCRIPTION AUTHOR COPYRIGHT SUMMARY>)
113   - and $pod.content[0] ~~ Pod::Block::Para {
114   - @meta.push: Pair.new(key => $pod.name.lc, value => prose2html($pod.content[0]));
115   - }
116   -
117   - '<section>'
118   - ~ "<h1>{$pod.name}</h1>\n"
119   - ~ whatever2html($pod.content)
120   - ~ "</section>\n"
121   - }
122   - }
123   -}
124   -
125   -sub prose2html($pod, $sep = '') {
126   - escape($pod.content.join($sep), 'html');
127   -}
128   -
129   -sub para2html($pod) {
130   - '<p>' ~ escape(twine2text($pod.content), 'html') ~ "</p>\n"
131   -}
132   -
133   -sub code2html($pod) {
134   - '<pre>' ~ prose2html($pod) ~ "</pre>\n"
135   -}
136   -
137   -sub item2html($pod) {
138   -#FIXME
139   - '<ul><li>' ~ whatever2html($pod.content) ~ "</li></ul>\n"
140   -}
141   -
142   -sub formatting2text($pod) {
143   - twine2text($pod.content)
144   -}
145   -
146   -sub twine2text($twine) {
147   - return '' unless $twine.elems;
148   - my $r = $twine[0];
149   - for $twine[1..*] -> $f, $s {
150   - $r ~= twine2text($f.content);
151   - $r ~= $s;
152   - }
153   - return $r;
154   -}
155   -
156   -sub table2html($pod) {
157   - my @r;
158   -
159   - if $pod.caption {
160   - @r.push("<caption>{escape($pod.caption, 'html')}</caption>");
161   - }
162   -
163   - if $pod.headers {
164   - @r.push(
165   - '<thead><tr>',
166   - $pod.headers.map(-> $cell {
167   - "<th>{escape($cell, 'html')}</th>"
168   - }),
169   - '</tr></thead>'
170   - );
171   - }
172   -
173   - @r.push(
174   - '<tbody>',
175   - $pod.content.map(-> $line {
176   - '<tr>',
177   - $line.list.map(-> $cell {
178   - "<td>{escape($cell, 'html')}</td>"
179   - }),
180   - '</tr>'
181   - }),
182   - '</tbody>'
183   - );
184   -
185   - return "<table>\n{@r.join("\n")}\n</table>";
186   -}
41 lib/Text/Escape.pm
... ... @@ -1,41 +0,0 @@
1   -use v6;
2   -module Text::Escape;
3   -
4   -sub escape_html($str as Str) {
5   - $str.subst('&', '&amp;', :g).subst('<', '&lt;', :g
6   - ).subst('>', '&gt;', :g).subst('"', '&quot;', :g
7   - ).subst("'", '&#39;', :g);
8   -}
9   -
10   -sub escape($str as Str, Str $how) is export {
11   - given $how.lc {
12   - when 'none' { $str }
13   - when 'html' { escape_html($str) }
14   - when 'uri' | 'url' { escape_str($str, &escape_uri_char) }
15   - default { fail "Don't know how to escape format $how yet" }
16   - }
17   -}
18   -
19   -sub escape_uri_char(Str $c) returns Str {
20   - return q{+} if $c eq q{ };
21   -
22   - my $allowed = 'abcdefghijklmnopqrstuvwxyz'
23   - ~ 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
24   - ~ '0123456789'
25   - ~ q{-_.!~*'()};
26   -
27   - return $c if defined $allowed.index($c);
28   -
29   - # TODO: each char should be UTF-8 encoded, then its bytes %-encoded
30   - return q{%} ~ ord($c).fmt('%x');
31   -}
32   -
33   -sub escape_str(Str $str, Callable $callback) returns Str {
34   - my $result = '';
35   - for ^$str.chars -> $index {
36   - $result ~= $callback($str.substr: $index, 1)
37   - }
38   - return $result;
39   -}
40   -
41   -# vim:ft=perl6

0 comments on commit 81a8cee

Please sign in to comment.
Something went wrong with that request. Please try again.