File Coverage

blib/lib/Pod/PseudoPod/PerlTricks/HTML.pm

Criterion	Covered	Total	%
statement	620	843	73.5
branch	287	690	41.5
condition	20	47	42.5
subroutine	81	107	75.7
pod	6	87	6.9
total	1014	1774	57.1

line stmt bran cond sub pod time code

1 1 1 2890 use v5.20;

1 3

1 33

2 1 1 3 use feature qw(signatures);

1 1

1 76

3 1 1 11 no warnings qw(experimental::signatures);

1 1

1 42

6 package Pod::PseudoPod::PerlTricks::HTML;

7 1 1 3 use strict;

1 1

1 21

8 1 1 370 use parent 'Pod::PseudoPod::PerlTricks';

1 201

1 4

10 1 1 47 use warnings;

1 1

1 29

11 1 1 2 no warnings;

1 2

1 34

13 1 1 4 use subs qw();

1 1

1 12

14 1 1 4 use vars qw($VERSION);

1 1

1 42

16 1 1 2 use Carp;

1 1

1 56

17 1 1 3 use Data::Dumper;

1 2

1 4592

19 $VERSION = '0.012';

21 183 50 183 0 207 sub DEBUG () { 0 }

183 110

183 251

23 =encoding utf8

25 =head1 NAME

27 Pod::PseudoPod::PerlTricks - Turn Pod into the HTML PerlTricks needs

29 =head1 SYNOPSIS

31 use Pod::PseudoPod::PerlTricks;

33 =head1 DESCRIPTION

35 ***THIS IS ALPHA SOFTWARE. MAJOR PARTS WILL CHANGE***

37 I wrote just enough of this module to get my job done, and I skipped

38 every part of the specification I didn't need while still making it

39 flexible enough to handle stuff later.

42 PerlTricks.com Style Guide v0.01

43 ========================== =====

44 By David Farrell

46 Introduction

47 ------------

48 This document is intended to guide PerlTricks authors in producing articles that are consistent with the aims of the website. None of this is set in stone - great writing should always prevail.

50 Goal

51 ----

52 We aspire to reasoned, insightful, professional writing with a lighthearted bent.

54 Topics of interest

55 ------------------

56 - Anything Perl related: news, events, tutorials, community

57 - Non-Perl programming subjects: version control, hosting, sysadmin

58 - Open Source

60 Looking for an idea for an article? Our bread and butter is: "here is something cool you can do with Perl". Start there.

62 Politics / Tone

63 ---------------

64 - We are pro: Perl, Open Source and free software

65 - No rants or "hit pieces"

66 - Reasoned criticism is fine

68 Language

69 --------

70 - American English

71 - 300-1,000 words per article

72 - Simple English (use http://www.hemingwayapp.com/ to help)

73 - Only capitalize the first letter of a word in headings (no title case)

74 - Articles can begin with an italicised introductory paragraph

75 - Technical terms / references when first used should be quoted in speech marks (")

76 - Use the first-person

77 - We are "PerlTricks.com"

78 - You can use "we" to refer to PerlTricks.com, the staff, our point of view etc.

79 - When referring to modules for the first time, provide a link to metacpan

81 Markup

82 ------

83 - HTML

for sub-headers

for paragraphs

86 - for links

87 - for inline code

for Perl code block

for plain code block

for blockquote

91 - , can be used for emphasis

93							- Inline images ... can be done, let me know if you need them and I'll upload in the backend
94
95							Questions or comments ? Email me: perltricks.com@gmail.com
96
97
98
99							=cut
100
101							=over 4
102
103							=cut
104
105	4	50		4		8	sub _ponder_begin ( $self, $para, $curr_open, $paras ){
	4	50				6
	4					4
	4					4
	4					2
	4					4
	4					3
106							# XXX this is such a messed up way to do this, but this is
107							# not designed to be extended
108	4	100				14	unless ($para->[2] =~ /^\s*(?:output\|terminal\|code)/) {
109	1					8	return $self->SUPER::_ponder_begin($para,$curr_open,$paras);
110							}
111
112	3					8	my $content = join ' ', splice @$para, 2;
113	3					4	$content =~ s/^\s+//s;
114	3					4	$content =~ s/\s+$//s;
115
116	3					10	my ($target, $title) = $content =~ m/^(\S+)\s(.)$/;
117	3					4	$para->[1]{'target'} = $target; # without any ':'
118
119	3	50				8	return 1 unless $self->{'accept_targets'}{$target};
120
121	3					4	$para->[0] = '=for'; # Just what we happen to call these, internally
122	3		50			8	$para->[1]{'~really'} \|\|= '=begin';
123	3					4	$para->[1]{'~resolve'} = 1;
124
125	3					3	push @$curr_open, $para;
126	3		50			8	$self->{'content_seen'} \|\|= 1;
127
128	3					8	$self->_handle_element_start( $target, $para->[1] );
129
130	3					8	return 1;
131							}
132
133	0	0		0	0	0	sub begin_for ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
134	0					0	my $target = $attributes->{target};
135	0					0	my $method = 'start_' . $target;
136
137	0	0				0	if( $self->can( $method ) ) {
138	0					0	$self->$method();
139							}
140							else {
141	0	0				0	DEBUG > 1 and print "No method $method";
142							}
143							}
144
145	3	50		3	0	70	sub end_for ( $self, $attributes={} ) {
	3	50				5
	3	50				4
	3					4
	3					3
146	3					3	my $target = $attributes->{target};
147	3					3	my $method = 'end_' . $target;
148
149	3	50				7	if( $self->can( $method ) ) {
150	3					6	$self->$method();
151							}
152							else {
153	0	0				0	DEBUG > 1 and print "No method $method";
154							}
155							}
156
157	77	50		77	0	94	sub add_html_tag ( $self, $stuff ) {
	77	50				81
	77					53
	77					51
	77					35
158	77					79	$self->add_to_pad( $stuff );
159	77					68	$self->emit;
160							}
161
162	0	0		0	0	0	sub add_data ( $self, $stuff ) {
	0	0				0
	0					0
	0					0
	0					0
163	0					0	$self->add_to_pad( $stuff );
164	0					0	$self->escape_and_emit;
165							}
166
167	16	50		16	0	21	sub escape_and_emit ( $self ) {
	16	50				20
	16					11
	16					8
168	16					21	my $pad = $self->get_pad;
169
170	16					20	$self->{$pad} =~ s/\s+\z//;
171
172	16					15	$self->{$pad} =~ s/&/&/g;
173	16					11	$self->{$pad} =~ s/
174	16					14	$self->{$pad} =~ s/>/>/g;
175
176	16					16	$self->emit;
177							}
178
179	83	50		83	0	96	sub add_to_pad ( $self, $stuff ) {
	83	50				92
	83					53
	83					50
	83					45
180	83					78	my $pad = $self->get_pad;
181	83					92	$self->{$pad} .= $stuff;
182							}
183
184	187	50		187	0	234	sub clear_pad ( $self ) {
	187	50				190
	187					119
	187					96
185	187					150	my $pad = $self->get_pad;
186	187					180	$self->{$pad} = '';
187							}
188
189	0	0		0	0	0	sub set_title ( $self, $title ) { $self->{title} = $title }
	0	0				0
	0					0
	0					0
	0					0
	0					0
190
191	0	0		0	0	0	sub title ( $self ) { $self->{title} }
	0	0				0
	0					0
	0					0
	0					0
192
193							=item document_header
194
195							The empty string. We don't worry about that here. The blogging
196							platform adds that.
197
198							=cut
199
200	1	50		1	1	3	sub document_header ( $self ) { '' }
	1	50				2
	1					2
	1					1
	1					5
201
202							=item document_footer
203
204							The empty string. We don't worry about that here. The blogging
205							platform adds that.
206
207							=cut
208
209	1	50		1	1	3	sub document_footer ( $self ) { '' }
	1	50				3
	1					1
	1					2
	1					2
210
211							=back
212
213							=head2 The Pod::Simple mechanics
214
215							Everything else is the same stuff from C.
216
217							=over 4
218
219							=cut
220
221	124	50		124	0	144	sub emit ( $self, $attributes={} ) {
	124	50				138
	124	50				62
	124					127
	124					82
222	124					75	print {$self->{'output_fh'}} $self->get_from_current_pad;
	124					152
223	124					644	$self->clear_pad;
224	124					140	return;
225							}
226
227	647	50		647	0	654	sub get_pad ( $self, $attributes={} ) {
	647	50				665
	647	50				350
	647					685
	647					365
228							# flow elements first
229	647	100				1815	if( $self->{module_flag} ) { 'scratch' }
	32	50				30
		100
		100
		100
		100
		100
230	0					0	elsif( $self->{in_U} ) { 'url_text' }
231	17					19	elsif( $self->{in_L} ) { 'link_text' }
232	9					10	elsif( $self->{in_output} ) { 'output_text' }
233	9					11	elsif( $self->{in_code} ) { 'code_text' }
234	9					12	elsif( $self->{in_terminal} ) { 'terminal_text' }
235	12					20	elsif( $self->{in_figure} ) { 'figure_text' }
236							# then block elements
237							# finally the default
238	559					596	else { 'scratch' }
239							}
240
241	184	50		184	0	198	sub get_from_current_pad ( $self ) {
	184	50				194
	184					105
	184					98
242	184					155	my $pad = $self->get_pad;
243	184					343	$self->{$pad};
244							}
245
246	56	50		56	0	65	sub add_to_current_pad ( $self, $text ) {
	56	50				67
	56					35
	56					45
	56					34
247	56					52	my $pad = $self->get_pad;
248	56					67	$self->{$pad} .= $text;
249							}
250
251	1	50		1	0	16	sub start_Document ( $self, $attributes={} ) {
	1	50				3
	1	50				2
	1					2
	1					1
252	1					2	$self->{in_section} = [];
253	1					4	$self->add_to_pad( $self->document_header );
254	1					2	$self->emit;
255							}
256
257	1	50		1	0	28	sub end_Document ( $self, $attributes={} ) {
	1	50				2
	1	50				1
	1					3
	1					1
258	1					3	$self->add_to_pad( $self->document_footer );
259	1					2	$self->emit;
260							}
261
262	5	50		5		8	sub _header_start ( $self, $level=1 ) {
	5	50				8
	5	50				5
	5					7
	5					3
263	5					6	$self->{in_header} = 1;
264	5					16	$self->add_html_tag( qq\|\| );
265							}
266	5	50		5		10	sub _header_end ( $self, $level=1 ) {
	5	50				8
	5	50				4
	5					7
	5					4
267	5					6	$self->{in_header} = 0;
268	5					9	$self->add_html_tag( "\n\n" );
269							}
270
271	1	50		1	0	14	sub start_head0 ( $self, $attributes={} ) { $self->_header_start( 0 ); }
	1	50				3
	1	50				1
	1					3
	1					1
	1					3
272	1	50		1	0	26	sub end_head0 ( $self, $attributes={} ) { $self->_header_end( 0 ); }
	1	50				3
	1	50				5
	1					4
	1					1
	1					3
273
274	2	50		2	0	19	sub end_head1 ( $self, $attributes={} ) { $self->_header_end( 1 ); }
	2	50				5
	2	50				2
	2					4
	2					2
	2					8
275	2	50		2	0	26	sub start_head1 ( $self, $attributes={} ) { $self->_header_start( 1 ); }
	2	50				5
	2	50				3
	2					5
	2					2
	2					4
276
277	2	50		2	0	18	sub end_head2 ( $self, $attributes={} ) { $self->_header_end( 2 ); }
	2	50				5
	2	50				3
	2					6
	2					2
	2					4
278	2	50		2	0	22	sub start_head2 ( $self, $attributes={} ) { $self->_header_start( 2 ); }
	2	50				5
	2	50				3
	2					4
	2					3
	2					5
279
280	0	0		0	0	0	sub start_head3 ( $self, $attributes={} ) { $self->_header_start( 3 ); }
	0	0				0
	0	0				0
	0					0
	0					0
	0					0
281	0	0		0	0	0	sub end_head3 ( $self, $attributes={} ) { $self->_header_end( 3 ); }
	0	0				0
	0	0				0
	0					0
	0					0
	0					0
282
283
284	18	50		18	0	27	sub end_non_code_text ( $self, $attributes={} ) {
	18	50				26
	18	50				13
	18					24
	18					15
285	18					18	$self->make_curly_quotes;
286
287	18					19	$self->emit;
288							}
289
290	0	0		0	0	0	sub make_para ( $self, $style, $para ) {
	0	0				0
	0					0
	0					0
	0					0
	0					0
291	0					0	$self->add_html_tag( ' ' );
292	0					0	$self->add_to_pad( $para );
293	0					0	$self->escape_and_emit;
294	0					0	$self->add_html_tag( "<\p>\n\n" );
295							}
296
297	17	50		17	0	130	sub start_Para ( $self, $attributes={} ) {
	17	50				21
	17	100				15
	17					20
	17					13
298	17	100				22	return if $self->{in_figure};
299	16					21	$self->add_html_tag( qq\| \| );
300
301	16					20	$self->escape_and_emit;
302
303	16					26	$self->{'in_para'} = 1;
304							}
305	17	50		17	0	97	sub end_Para ( $self, $attributes={} ) {
	17	50				21
	17	100				11
	17					21
	17					11
306	17	100				21	return if $self->{in_figure};
307	16					19	$self->add_html_tag( " \n\n" );
308
309	16					20	$self->end_non_code_text;
310
311	16					21	$self->{'in_para'} = 0;
312							}
313
314							=item * start_Verbatim
315
316							=item * end_Verbatim
317
318							This is for the code and output sections.
319
320							=cut
321
322	3	50		3	1	27	sub start_Verbatim ( $self, $attributes={} ) {
	3	50				6
	3	50				2
	3					9
	3					2
323	3					4	$self->{'in_verbatim'} = 1;
324	3					4	my $sequence = ++$self->{'verbatim_sequence'};
325
326	3	100				12	if( $self->{'in_output'} ) {
		100
		50
327	1					2	$self->add_html_tag( qq\|\n\n \| );
328							}
329							elsif( $self->{'in_code'} ) {
330	1					2	$self->add_html_tag( qq\|\n\n `\| );`
331							}
332							elsif( $self->{'in_terminal'} ) {
333	1					3	$self->add_html_tag( qq\|\n\n `\| );`
334							}
335							else {
336	0					0	$self->add_html_tag( qq\|\n\n \| );
337							}
338
339	3					13	$self->emit;
340							}
341
342	3	50		3	1	22	sub end_Verbatim ( $self, $attributes={} ) {
	3	50				4
	3	50				3
	3					8
	3					3
343	3	100				8	if( $self->{'in_output'} ) {
		100
		50
344	1					2	$self->add_html_tag( qq\|\n\n\| );
345							}
346							elsif( $self->{'in_code'} ) {
347	1					2	$self->add_html_tag( qq\|\n\n\| );
348							}
349							elsif( $self->{'in_terminal'} ) {
350	1					2	$self->add_html_tag( qq\|\n\n\| );
351							}
352							else {
353	0					0	$self->add_html_tag( qq\|\n\n\| );
354							}
355
356	3					5	$self->{'in_verbatim'} = 0;
357							}
358
359							=item * start_output
360
361							=item * end_output
362
363							These methods simple set flags and defer everything else to the
364							verbatim handler.
365
366							=cut
367
368	1	50		1	1	8	sub start_output ( $self, $attributes={} ) {
	1	50				3
	1	50				1
	1					2
	1					2
369	1					2	$self->{'in_output'} = 1;
370							}
371	1	50		1	1	4	sub end_output ( $self, $attributes={} ) {
	1	50				7
	1	50				2
	1					2
	1					2
372	1					3	$self->{'in_output'} = 0;
373							}
374
375	1	50		1	0	11	sub start_code ( $self, $attributes={} ) {
	1	50				3
	1	50				1
	1					3
	1					1
376	1					2	$self->{'in_code'} = 1;
377							}
378	1	50		1	0	3	sub end_code ( $self, $attributes={} ) {
	1	50				2
	1	50				4
	1					3
	1					2
379	1					3	$self->{'in_code'} = 0;
380							}
381
382	1	50		1	0	8	sub start_terminal ( $self, $attributes={} ) {
	1	50				2
	1	50				1
	1					3
	1					1
383	1					2	$self->{'in_terminal'} = 1;
384							}
385	1	50		1	0	3	sub end_terminal ( $self, $attributes={} ) {
	1	50				2
	1	50				1
	1					2
	1					2
386	1					3	$self->{'in_terminal'} = 0;
387							}
388
389	1	50		1	0	36	sub start_figure ( $self, $attributes={} ) {
	1	50				3
	1	50				1
	1					2
	1					1
390	1					2	$self->{in_figure} = 1;
391	1					2	$self->{figure_title} = $attributes->{title};
392
393	1					2	my $pad = $self->get_pad;
394							}
395
396							sub end_figure {
397	1			1	0	35	my( $self, $flags ) = @_;
398
399	1					2	my $pad = $self->get_pad;
400	1					2	my $filename = $self->{$pad};
401	1					2	$self->clear_pad;
402
403	1					5	$self->add_html_tag(
404							"\n\n" .
405							qq( ) .
406							"\n\n"
407
408							);
409
410	1					42	$self->{figure_title} = 0;
411	1					3	$self->{in_figure} = 0;
412							}
413
414	2	50		2		15	sub _get_initial_item_type ( $self, $attributes={} ) {
	2	50				4
	2	50				2
	2					5
	2					2
415	2					9	my $type = $self->SUPER::_get_initial_item_type;
416
417	2					4	$type;
418							}
419
420	0	0		0	0	0	sub not_implemented ( $self, $attributes={} ) { croak "Not implemented! " . (caller(1))[3] }
	0	0				0
	0	0				0
	0					0
	0					0
	0					0
421
422	0	0		0	0	0	sub in_item_list ( $self, $attributes={} ) { scalar @{ $self->{list_levels} } }
	0	0				0
	0	0				0
	0					0
	0					0
	0					0
	0					0
423	4	50		4	0	7	sub add_list_level_item ( $self, $attributes={} ) {
	4	50				6
	4	50				3
	4					6
	4					3
424	4					4	${ $self->{list_levels} }[-1]{item_count}++;
	4					7
425							}
426	4	50		4	0	6	sub is_first_list_level_item ( $self, $attributes={} ) {
	4	50				5
	4	50				4
	4					7
	4					3
427	4					3	${ $self->{list_levels} }[-1]{item_count} == 0;
	4					14
428							}
429
430	2	50		2	0	4	sub start_list_level ( $self, $attributes={} ) {
	2	50				5
	2	50				2
	2					3
	2					2
431	2					2	push @{ $self->{list_levels} }, { item_count => 0 };
	2					7
432							}
433
434	2	50		2	0	4	sub end_list_level ( $self, $attributes={} ) {
	2	50				3
	2	50				2
	2					4
	2					2
435	2					2	pop @{ $self->{list_levels} };
	2					2
436							}
437
438	4	50		4	0	38	sub start_item_bullet ( $self, $attributes={} ) {
	4	50				6
	4	50				4
	4					7
	4					1
439							#print STDERR Dumper($self->{list_levels}), "\n"; use Data::Dumper;
440	4	100				9	$self->add_html_tag( "\n\n" )
441							unless $self->is_first_list_level_item;
442	4					6	$self->add_list_level_item;
443	4					6	$self->add_html_tag( " \n" );
444	4					6	$self->start_Para;
445							}
446
447	0	0		0	0	0	sub start_item_number ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
448	0					0	$self->add_html_tag( ' ' )
449							}
450	0	0		0	0	0	sub start_item_block ( $self, $attributes={} ) { $self->add_html_tag( ' ' ) }
	0	0				0
	0	0				0
	0					0
	0					0
	0					0
451	0	0		0	0	0	sub start_item_text ( $self, $attributes={} ) { $self->add_html_tag( ' ' ) }
	0	0				0
	0	0				0
	0					0
	0					0
	0					0
452
453	4	50		4	0	34	sub end_item_bullet ( $self, $attributes={} ) {
	4	50				7
	4	50				3
	4					10
	4					2
454	4					6	$self->end_Para;
455							# $self->add_to_pad( "\n\n" );
456	4					8	$self->{in_item} = 0;
457							}
458	0	0		0	0	0	sub end_item_number ( $self, $attributes={} ) { $self->add_html_tag( '' ) }
	0	0				0
	0	0				0
	0					0
	0					0
	0					0
459	0	0		0	0	0	sub end_item_block ( $self, $attributes={} ) { $self->add_html_tag( '' ) }
	0	0				0
	0	0				0
	0					0
	0					0
	0					0
460	0	0		0	0	0	sub end_item_text ( $self, $attributes={} ) { $self->add_html_tag( '' ) }
	0	0				0
	0	0				0
	0					0
	0					0
	0					0
461
462	2	50		2	0	46	sub start_over_bullet ( $self, $attributes={} ) {
	2	50				3
	2	50				3
	2					3
	2					2
463	2					3	$self->add_html_tag( qq( ) );
464	2					4	$self->start_list_level;
465							}
466
467	0	0		0	0	0	sub start_over_text ( $self, $attributes={} ) { $self->add_html_tag( ' ' ) }
	0	0				0
	0	0				0
	0					0
	0					0
	0					0
468	0	0		0	0	0	sub start_over_block ( $self, $attributes={} ) { $self->add_html_tag( ' ' ) }
	0	0				0
	0	0				0
	0					0
	0					0
	0					0
469	0	0		0	0	0	sub start_over_number ( $self, $attributes={} ) { $self->add_html_tag( ' ' ) }
	0	0				0
	0	0				0
	0					0
	0					0
	0					0
470
471	2	50		2	0	34	sub end_over_bullet ( $self, $attributes={} ) {
	2	50				6
	2	50				2
	2					4
	2					1
472	2					3	$self->{last_thingy} = 'item_list';
473	2					4	$self->end_non_code_text;
474	2					3	$self->add_html_tag( "\n\n" );
475
476							# $self->add_to_pad( "\n\n" ); XXX: WTF?
477	2					6	$self->end_list_level;
478	2					4	$self->emit;
479							}
480
481	0	0		0	0	0	sub end_over_text ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
482	0					0	$self->add_html_tag( '' );
483	0					0	$self->add_html_tag( '' )
484							}
485	0	0		0	0	0	sub end_over_block ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
486	0					0	$self->add_html_tag( '' );
487	0					0	$self->add_html_tag( '' )
488							}
489	0	0		0	0	0	sub end_over_number ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
490	0					0	$self->add_html_tag( '' );
491	0					0	$self->add_html_tag( '' )
492							}
493
494
495
496	1	50		1	0	11	sub end_B ( $self, $attributes={} ) { $self->add_html_tag( '' ); $self->{in_B} = 0; }
	1	50				2
	1	50				2
	1					2
	1					1
	1					2
	1					2
497	1	50		1	0	13	sub start_B ( $self, $attributes={} ) {
	1	50				2
	1	50				2
	1					2
	1					2
498	1					1	$self->add_html_tag( '`' );`
499	1					3	$self->{in_B} = 1;
500							}
501
502	2	50		2	0	17	sub end_C ( $self, $attributes={} ) { $self->add_html_tag( '' ); $self->{in_C} = 0; }
	2	50				7
	2	50				1
	2					4
	2					2
	2					3
	2					3
503	2	50		2	0	26	sub start_C ( $self, $attributes={} ) { $self->add_html_tag( '`' ); $self->{in_C} = 1; }`
	2	50				3
	2	50				2
	2					8
	2					2
	2					3
	2					3
504
505	0	0		0	0	0	sub end_F ( $self, $attributes={} ) { $self->add_html_tag( '' ) }
	0	0				0
	0	0				0
	0					0
	0					0
	0					0
506	0	0		0	0	0	sub start_F ( $self, $attributes={} ) { $self->add_html_tag( '' ) }
	0	0				0
	0	0				0
	0					0
	0					0
	0					0
507
508	1	50		1	0	10	sub end_I ( $self, $attributes={} ) { $self->add_html_tag( '' ) }
	1	50				2
	1	50				2
	1					1
	1					1
	1					2
509	1	50		1	0	13	sub start_I ( $self, $attributes={} ) { $self->add_html_tag( '' ) }
	1	50				2
	1	50				2
	1					2
	1					1
	1					2
510
511							# keyword
512	1	50		1	0	10	sub end_K ( $self, $attributes={} ) {
	1	50				2
	1	50				2
	1					3
	1					1
513	1					2	my $text = $self->get_from_current_pad;
514	1					2	$self->clear_pad;
515	1					1	my $link = do {
516							## what if it isn't a keyword??? XXX
517	1					2	"http://perldoc.perl.org/function/$text.html"
518							};
519
520	1					3	$self->add_html_tag( qq\|\| );
521	1					2	$self->add_to_pad( $text );
522	1					2	$self->add_html_tag( '' );
523	1					2	$self->emit;
524	1					2	$self->{in_K} = 0;
525							}
526
527	1	50		1	0	14	sub start_K ( $self, $attributes={} ) {
	1	50				2
	1	50				2
	1					3
	1					1
528	1					2	$self->emit;
529	1					2	$self->{in_K} = 1;
530							}
531
532	1	50		1	0	10	sub end_L ( $self, $attributes={} ) {
	1	50				3
	1	50				1
	1					3
	1					1
533	1					3	my $text = $self->get_from_current_pad;
534	1					3	$self->clear_pad;
535	1					1	my $link = do {
536	1	50				6	if( $text =~ /\A(perl[a-z0-9]+)\z/ ) { "http://perldoc.perl.org/$1.html" }
	1					9
537							};
538
539	1					4	$self->add_html_tag( qq\|\| );
540	1					2	$self->add_to_pad( $text );
541	1					2	$self->add_html_tag( '' );
542	1					2	$self->emit;
543	1					3	$self->{in_L} = 0;
544							}
545	1	50		1	0	12	sub start_L ( $self, $attributes={} ) {
	1	50				3
	1	50				1
	1					2
	1					1
546	1					2	$self->emit;
547	1					3	$self->{in_L} = 1;
548							}
549
550	2	50		2	0	26	sub start_M ( $self, $attributes={} ) {
	2	50				4
	2	50				3
	2					4
	2					3
551	2					3	$self->emit;
552	2					3	$self->{'module_flag'} = 1;
553	2					5	$self->{'module_text'} = '';
554							}
555	2	50		2	0	19	sub end_M ( $self, $attributes={} ) {
	2	50				5
	2	50				2
	2					4
	2					2
556	2					3	my $text = $self->get_from_current_pad;
557	2					3	$self->clear_pad;
558
559	2					3	my $href = "https://www.metacpan.org/module/$text";
560
561	2					9	$self->add_html_tag( qq() );
562	2					2	$self->add_to_pad( $text );
563	2					3	$self->add_html_tag( '' );
564	2					5	$self->clear_pad;
565
566	2					5	$self->{'module_flag'} = 0;
567							}
568
569	1	50		1	0	16	sub start_T ( $self, $attributes={} ) { $self->add_html_tag( '' ) }
	1	50				2
	1	50				2
	1					2
	1					2
	1					2
570	1	50		1	0	11	sub end_T ( $self, $attributes={} ) { $self->add_html_tag( '' ) }
	1	50				6
	1	50				2
	1					2
	1					2
	1					2
571
572	0	0		0	0	0	sub start_U ( $self, $attributes={} ) { $self->emit; $self->{in_U} = 1 }
	0	0				0
	0	0				0
	0					0
	0					0
	0					0
	0					0
573	0	0		0	0	0	sub end_U ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
574	0					0	my $text = $self->get_from_current_pad;
575	0					0	$self->clear_pad;
576
577	0					0	$self->add_html_tag( qq\|\| );
578	0					0	$self->emit;
579	0					0	$self->{in_U} = 0;
580							}
581
582	43	50		43	0	341	sub handle_text ( $self, $text ) {
	43	50				47
	43					31
	43					28
	43					28
583	43					33	my $pad = $self->get_pad;
584
585	43					54	$self->escape_text( \$text );
586	43					46	$self->{$pad} .= $text;
587
588	43	100				44	unless( $self->dont_escape ) {
589	38					40	$self->make_curly_quotes;
590	38					45	$self->make_em_dashes;
591	38					44	$self->make_ellipses;
592							}
593							}
594
595	43	50		43	0	51	sub dont_escape ( $self ) {
	43	50				47
	43					24
	43					28
596	43	100				136	$self->{in_verbatim} \|\| $self->{in_C}
597							}
598
599	43	50		43	0	78	sub escape_text ( $self, $text_ref ) {
	43	50				53
	43					27
	43					27
	43					27
600	43					45	$$text_ref =~ s/&/&/g;
601	43					32	$$text_ref =~ s/
602
603	43					36	return 1;
604							}
605
606	56	50		56	0	62	sub make_curly_quotes ( $self ) {
	56	50				63
	56					37
	56					32
607	56					56	my $text = $self->get_from_current_pad;
608
609	56					543	require Tie::Cycle;
610
611	56					633	tie my $cycle, 'Tie::Cycle', [ qw( “ ” ) ];
612
613	56					694	1 while $text =~ s/"/$cycle/;
614
615							# escape escape chars. This is escpaing them for InDesign
616							# so don't worry about double escaping for other levels. Don't
617							# worry about InDesign in the pod.
618	56					53	$text =~ s/'/’/g;
619
620	56					63	$self->clear_pad;
621	56					65	$self->add_to_current_pad( $text );
622
623	56					90	return 1;
624							}
625
626	38	50		38	0	54	sub make_em_dashes ( $self ) {
	38	50				41
	38					26
	38					23
627	38					37	my $pad = $self->get_pad;
628	38					41	$self->{$pad} =~ s/--/—/g;
629	38					29	return 1;
630							}
631
632	38	50		38	0	49	sub make_ellipses ( $self ) {
	38	50				47
	38					22
	38					22
633	38					40	my $pad = $self->get_pad;
634	38					38	$self->{$pad} =~ s/\Q.../…/g;
635	38					66	return 1;
636							}
637
638							BEGIN {
639	1			1		279	require Pod::Simple::BlackBox;
640
641							package Pod::Simple::BlackBox;
642
643	3	50		3		6	sub _ponder_Verbatim ( $self, $para ) {
	3	50				4
	3					4
	3					2
	3					2
644	3					2	DEBUG and print STDERR " giving verbatim treatment...\n";
645
646	3					5	$para->[1]{'xml:space'} = 'preserve';
647	3					7	foreach my $line ( @$para[ 2 .. $#$para ] ) {
648	13					21	$line =~ s/\A(\t\| )//gm;
649	13					12	$line =~ s/\A(\t+)/" " x ( 4 * length($1) )/e;
	0					0
650	13	50				20	warn
651							sprintf(
652							"%s: tab in code listing! [%s]",
653							$self->chapter,
654							$line
655							) if $line =~ /\t/;
656							}
657
658							# Now the VerbatimFormatted hoodoo...
659	3	50	33			19	if( $self->{'accept_codes'} and
		50
660							$self->{'accept_codes'}{'VerbatimFormatted'}
661							) {
662	0		0			0	while(@$para > 3 and $para->[-1] !~ m/\S/) { pop @$para }
	0					0
663							# Kill any number of terminal newlines
664	0					0	$self->_verbatim_format($para);
665							} elsif ($self->{'codes_in_verbatim'}) {
666	0					0	push @$para,
667	0					0	@{$self->_make_treelet(
668							join("\n", splice(@$para, 2)),
669							$para->[1]{'start_line'}, $para->[1]{'xml:space'}
670							)};
671	0					0	$para->[-1] =~ s/\n+$//s; # Kill any number of terminal newlines
672							} else {
673	3	50				13	push @$para, join "\n", splice(@$para, 2) if @$para > 3;
674	3					10	$para->[-1] =~ s/\n+$//s; # Kill any number of terminal newlines
675							}
676	3					4	return;
677							}
678
679							}
680
681	1			1		1127	BEGIN {
682
683							# override _treat_Es so I can localize e2char
684							sub _treat_Es {
685	4			4		832	my $self = shift;
686
687	4					13	require Pod::Escapes;
688	4					9	local Pod::Escapes::e2char = e2char_tagged_text;
689
690	4					20	$self->SUPER::_treat_Es( @_ );
691							}
692
693							sub e2char_tagged_text {
694							package Pod::Escapes;
695
696	0			0	0	0	my $in = shift;
697
698	0	0	0			0	return unless defined $in and length $in;
699
700	0	0				0	if( $in =~ m/^(0[0-7]*)$/ ) { $in = oct $in; }
	0	0				0
701	0					0	elsif( $in =~ m/^0?x([0-9a-fA-F]+)$/ ) { $in = hex $1; }
702
703	0	0				0	if( $NOT_ASCII ) {
704	0	0				0	unless( $in =~ m/^\d+$/ )
705							{
706	0					0	$in = $Name2character{$in};
707	0	0				0	return unless defined $in;
708	0					0	$in = ord $in;
709							}
710
711	0		0			0	return $Code2USASCII{$in}
712							\|\| $Latin1Code_to_fallback{$in}
713							\|\| $FAR_CHAR;
714							}
715
716	0	0	0			0	if( defined $Name2character_number{$in} and $Name2character_number{$in} < 127 ) {
		0
717	0					0	return "&$in;";
718							}
719							elsif( defined $Name2character_number{$in} ) {
720							# this needs to be fixed width because I want to look for
721							# it in a negative lookbehind
722	0					0	return sprintf '&#x%04x;', $Name2character_number{$in};
723							}
724							else
725							{
726	0					0	return '???';
727							}
728
729							}
730							}
731
732							=back
733
734							=head1 TO DO
735
736
737							=head1 SEE ALSO
738
739							L, L
740
741							=head1 SOURCE AVAILABILITY
742
743							This source is in Github:
744
745							http://github.com/briandfoy/pod-pseudopod-perltricks
746
747							If, for some reason, I disappear from the world, one of the other
748							members of the project can shepherd this module appropriately.
749
750							=head1 AUTHOR
751
752							brian d foy, C<< >>
753
754							=head1 COPYRIGHT AND LICENSE
755
756							Copyright © 2014-2015, brian d foy . All rights reserved.
757
758							You may redistribute this under the same terms as Perl itself.
759
760							=cut
761
762	39	50		39		4337	sub _ponder_paragraph_buffer ( $self ) {
	39	50				43
	39					28
	39					22
763
764							# Para-token types as found in the buffer.
765							# ~Verbatim, ~Para, ~end, =head1..4, =for, =begin, =end,
766							# =over, =back, =item
767							# and the null =pod (to be complained about if over one line)
768							#
769							# "~data" paragraphs are something we generate at this level, depending on
770							# a currently open =over region
771
772							# Events fired: Begin and end for:
773							# directivename (like head1 .. head4), item, extend,
774							# for (from =begin...=end, =for),
775							# over-bullet, over-number, over-text, over-block,
776							# item-bullet, item-number, item-text,
777							# Document,
778							# Data, Para, Verbatim
779							# B, C, longdirname (TODO -- wha?), etc. for all directives
780							#
781
782	39					49	my $paras;
783	39	100				16	return unless @{$paras = $self->{'paras'}};
	39					62
784	38		100			56	my $curr_open = ($self->{'curr_open'} \|\|= []);
785
786	38	50				38	DEBUG > 10 and print "# Paragraph buffer: <<", Pod::Simple::BlackBox::pretty($paras), ">>\n";
787
788							# We have something in our buffer. So apparently the document has started.
789	38	100				51	unless($self->{'doc_has_started'}) {
790	1					2	$self->{'doc_has_started'} = 1;
791
792	1					1	my $starting_contentless;
793	1		33			8	$starting_contentless =
794							(
795							!@$curr_open
796							and @$paras and ! grep $_->[0] ne '~end', @$paras
797							# i.e., if the paras is all ~ends
798							)
799							;
800	1	0				2	DEBUG and print "# Starting ",
		50
801							$starting_contentless ? 'contentless' : 'contentful',
802							" document\n"
803							;
804
805	1	50				10	$self->_handle_element_start('Document',
806							{
807							'start_line' => $paras->[0][1]{'start_line'},
808							$starting_contentless ? ( 'contentless' => 1 ) : (),
809							},
810							);
811							}
812
813	38					25	my($para, $para_type);
814	38					50	while(@$paras) {
815	47	100	100			221	last if @$paras == 1 and
			66
816							( $paras->[0][0] eq '=over' or $paras->[0][0] eq '~Verbatim'
817							or $paras->[0][0] eq '=item' )
818							;
819							# Those're the three kinds of paragraphs that require lookahead.
820							# Actually, an "=item Foo" inside an region
821							# and any =item inside an region (rare)
822							# don't require any lookahead, but all others (bullets
823							# and numbers) do.
824
825							# TODO: winge about many kinds of directives in non-resolving =for regions?
826							# TODO: many? like what? =head1 etc?
827
828	38					30	$para = shift @$paras;
829	38					38	$para_type = $para->[0];
830
831	38	50				36	DEBUG > 1 and print "Pondering a $para_type paragraph, given the stack: (",
832							$self->_dump_curr_open(), ")\n";
833
834	38	50				87	if($para_type eq '=for') {
		100
		100
		100
835	0	0				0	next if $self->_ponder_for($para,$curr_open,$paras);
836							} elsif($para_type eq '=begin') {
837	4	50				9	next if $self->_ponder_begin($para,$curr_open,$paras);
838							} elsif($para_type eq '=end') {
839	4	50				31	next if $self->_ponder_end($para,$curr_open,$paras);
840							} elsif($para_type eq '~end') { # The virtual end-document signal
841	1	50				10	next if $self->_ponder_doc_end($para,$curr_open,$paras);
842							}
843
844
845							# ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
846							#~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
847	29	50				55	if(grep $_->[1]{'~ignore'}, @$curr_open) {
848	0	0				0	DEBUG > 1 and
849							print "Skipping $para_type paragraph because in ignore mode.\n";
850	0					0	next;
851							}
852							#~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
853							# ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
854
855	29	50				77	if($para_type eq '=pod') {
		100
		100
		50
		50
		50
856	0					0	$self->_ponder_pod($para,$curr_open,$paras);
857							} elsif($para_type eq '=over') {
858	2	50				12	next if $self->_ponder_over($para,$curr_open,$paras);
859							} elsif($para_type eq '=back') {
860	2	50				11	next if $self->_ponder_back($para,$curr_open,$paras);
861							} elsif($para_type eq '=row') {
862	0	0				0	next if $self->_ponder_row_start($para,$curr_open,$paras);
863
864							} elsif( $para_type eq '=headrow'){
865	0					0	$self->start_headrow;
866							} elsif( $para_type eq '=bodyrows') {
867	0					0	$self->start_bodyrows;
868							}
869
870							else {
871							# All non-magical codes!!!
872
873							# Here we start using $para_type for our own twisted purposes, to
874							# mean how it should get treated, not as what the element name
875							# should be.
876
877	25	50				23	DEBUG > 1 and print "Pondering non-magical $para_type\n";
878
879							# In tables, the start of a headrow or bodyrow also terminates an
880							# existing open row.
881	25	50	33			65	if($para_type eq '=headrow' \|\| $para_type eq '=bodyrows') {
882	0					0	$self->_ponder_row_end($para,$curr_open,$paras);
883							}
884
885							# Enforce some =headN discipline
886	25	50	66			63	if($para_type =~ m/^=head\d$/s
			66
			33
887							and ! $self->{'accept_heads_anywhere'}
888							and @$curr_open
889							and $curr_open->[-1][0] eq '=over'
890							) {
891	0	0				0	DEBUG > 2 and print "'=$para_type' inside an '=over'!\n";
892	0					0	$self->whine(
893							$para->[1]{'start_line'},
894							"You forgot a '=back' before '$para_type'"
895							);
896	0					0	unshift @$paras, ['=back', {}, ''], $para; # close the =over
897	0					0	next;
898							}
899
900
901	25	100	33			98	if($para_type eq '=item') {
		50
		50
		100
		100
		50
		50
902	4	50				12	next if $self->_ponder_item($para,$curr_open,$paras);
903	4					126	$para_type = 'Plain';
904							# Now fall thru and process it.
905
906							} elsif($para_type eq '=extend') {
907							# Well, might as well implement it here.
908	0					0	$self->_ponder_extend($para);
909	0					0	next; # and skip
910							} elsif($para_type eq '=encoding') {
911							# Not actually acted on here, but we catch errors here.
912	0					0	$self->_handle_encoding_second_level($para);
913
914	0					0	next; # and skip
915							} elsif($para_type eq '~Verbatim') {
916	3					4	$para->[0] = 'Verbatim';
917	3					2	$para_type = '?Verbatim';
918							} elsif($para_type eq '~Para') {
919	13					11	$para->[0] = 'Para';
920	13					10	$para_type = '?Plain';
921							} elsif($para_type eq 'Data') {
922	0					0	$para->[0] = 'Data';
923	0					0	$para_type = '?Data';
924							} elsif( $para_type =~ s/^=//s
925							and defined( $para_type = $self->{'accept_directives'}{$para_type} )
926							) {
927	5	50				8	DEBUG > 1 and print " Pondering known directive ${$para}[0] as $para_type\n";
	0					0
928							} else {
929							# An unknown directive!
930	0					0	DEBUG > 1 and printf "Unhandled directive %s (Handled: %s)\n",
931	0	0				0	$para->[0], join(' ', sort keys %{$self->{'accept_directives'}} )
932							;
933	0					0	$self->whine(
934							$para->[1]{'start_line'},
935							"Unknown directive: $para->[0]"
936							);
937
938							# And maybe treat it as text instead of just letting it go?
939	0					0	next;
940							}
941
942	25	50				28	DEBUG > 1 and print "para_type is $para_type\n";
943	25	100				61	if($para_type =~ s/^\?//s) {
944	16	100				21	if(! @$curr_open) { # usual case
945	10	50				7	DEBUG and print "Treating $para_type paragraph as such because stack is empty.\n";
946							} else {
947	6					14	my @fors = grep $_->[0] eq '=for', @$curr_open;
948	6	50				8	DEBUG > 1 and print "Containing fors: ",
949							join(',', map $_->[1]{'target'}, @fors), "\n";
950
951	6	100				16	if(! @fors) {
		50
952	2	50				2	DEBUG and print "Treating $para_type paragraph as such because stack has no =for's\n";
953
954							#} elsif(grep $_->[1]{'~resolve'}, @fors) {
955							#} elsif(not grep !$_->[1]{'~resolve'}, @fors) {
956							} elsif( $fors[-1][1]{'~resolve'} ) {
957							# Look to the immediately containing for
958	4	50				3	DEBUG and print "~resolve is $fors[-1][1]{'~resolve'}\n";
959
960	4	50				7	if($para_type eq 'Data') {
961	0	0				0	DEBUG and print "Treating Data paragraph as Plain/Verbatim because the containing =for ($fors[-1][1]{'target'}) is a resolver\n";
962	0					0	$para->[0] = 'Para';
963	0					0	$para_type = 'Plain';
964							} else {
965	4	50				4	DEBUG and print "Treating $para_type paragraph as such because the containing =for ($fors[-1][1]{'target'}) is a resolver\n";
966							}
967							} else {
968	0	0				0	DEBUG and print "Treating $para_type paragraph as Data because the containing =for ($fors[-1][1]{'target'}) is a non-resolver\n";
969	0					0	$para->[0] = $para_type = 'Data';
970							}
971							}
972							}
973
974							#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
975	25	100				35	if($para_type eq 'Plain') {
		50
		0
976	22					80	$self->_ponder_Plain($para);
977							} elsif($para_type eq 'Verbatim') {
978	3					12	$self->_ponder_Verbatim($para);
979							} elsif($para_type eq 'Data') {
980	0					0	$self->_ponder_Data($para);
981							} else {
982	0					0	die "\$para type is $para_type -- how did that happen?";
983							# Shouldn't happen.
984							}
985
986							#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
987	25					1099	$para->[0] =~ s/^[~=]//s;
988
989	25	50				35	DEBUG and print "\n", Pod::Simple::BlackBox::pretty($para), "\n";
990
991							# traverse the treelet (which might well be just one string scalar)
992	25		100			39	$self->{'content_seen'} \|\|= 1;
993	25					54	$self->_traverse_treelet_bit(@$para);
994							}
995							}
996
997	38					139	return;
998							}
999
1000							1;