File Coverage

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

Criterion	Covered	Total	%
statement	172	843	20.4
branch	79	690	11.4
condition	10	47	21.2
subroutine	29	107	27.1
pod	6	87	6.9
total	296	1774	16.6

line stmt bran cond sub pod time code

1 1 1 3113 use v5.20;

1 3

1 31

2 1 1 5 use feature qw(signatures);

1 1

1 85

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

1 1

1 46

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

7 1 1 4 use strict;

1 1

1 24

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

1 199

1 4

10 1 1 43 use warnings;

1 1

1 25

11 1 1 3 no warnings;

1 1

1 28

13 1 1 3 use subs qw();

1 1

1 11

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

1 1

1 38

16 1 1 3 use Carp;

1 1

1 41

17 1 1 3 use Data::Dumper;

1 1

1 4706

19 $VERSION = '0.011';

21 7 50 7 0 11 sub DEBUG () { 0 }

7 5

7 16

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	0	0		0		0	sub _ponder_begin ( $self, $para, $curr_open, $paras ){
	0	0				0
	0					0
	0					0
	0					0
	0					0
	0					0
106							# XXX this is such a messed up way to do this, but this is
107							# not designed to be extended
108	0	0				0	unless ($para->[2] =~ /^\s*(?:output\|terminal\|code)/) {
109	0					0	return $self->SUPER::_ponder_begin($para,$curr_open,$paras);
110							}
111
112	0					0	my $content = join ' ', splice @$para, 2;
113	0					0	$content =~ s/^\s+//s;
114	0					0	$content =~ s/\s+$//s;
115
116	0					0	my ($target, $title) = $content =~ m/^(\S+)\s(.)$/;
117	0					0	$para->[1]{'target'} = $target; # without any ':'
118
119	0	0				0	return 1 unless $self->{'accept_targets'}{$target};
120
121	0					0	$para->[0] = '=for'; # Just what we happen to call these, internally
122	0		0			0	$para->[1]{'~really'} \|\|= '=begin';
123	0					0	$para->[1]{'~resolve'} = 1;
124
125	0					0	push @$curr_open, $para;
126	0		0			0	$self->{'content_seen'} \|\|= 1;
127
128	0					0	$self->_handle_element_start( $target, $para->[1] );
129
130	0					0	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	0	0		0	0	0	sub end_for ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
146	0					0	my $target = $attributes->{target};
147	0					0	my $method = 'end_' . $target;
148
149	0	0				0	if( $self->can( $method ) ) {
150	0					0	$self->$method();
151							}
152							else {
153	0	0				0	DEBUG > 1 and print "No method $method";
154							}
155							}
156
157	1	50		1	0	1	sub add_html_tag ( $self, $stuff ) {
	1	50				2
	1					1
	1					1
	1					1
158	1					2	$self->add_to_pad( $stuff );
159	1					1	$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	0	0		0	0	0	sub escape_and_emit ( $self ) {
	0	0				0
	0					0
	0					0
168	0					0	my $pad = $self->get_pad;
169
170	0					0	$self->{$pad} =~ s/\s+\z//;
171
172	0					0	$self->{$pad} =~ s/&/&/g;
173	0					0	$self->{$pad} =~ s/
174	0					0	$self->{$pad} =~ s/>/>/g;
175
176	0					0	$self->emit;
177							}
178
179	2	50		2	0	4	sub add_to_pad ( $self, $stuff ) {
	2	50				5
	2					2
	2					1
	2					2
180	2					4	my $pad = $self->get_pad;
181	2					4	$self->{$pad} .= $stuff;
182							}
183
184	2	50		2	0	3	sub clear_pad ( $self ) {
	2	50				3
	2					2
	2					1
185	2					2	my $pad = $self->get_pad;
186	2					3	$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	2	sub document_header ( $self ) { '' }
	1	50				2
	1					2
	1					1
	1					3
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	0	0		0	1	0	sub document_footer ( $self ) { '' }
	0	0				0
	0					0
	0					0
	0					0
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	2	50		2	0	4	sub emit ( $self, $attributes={} ) {
	2	50				2
	2	50				3
	2					3
	2					1
222	2					2	print {$self->{'output_fh'}} $self->get_from_current_pad;
	2					4
223	2					17	$self->clear_pad;
224	2					4	return;
225							}
226
227	8	50		8	0	10	sub get_pad ( $self, $attributes={} ) {
	8	50				10
	8	50				7
	8					10
	8					7
228							# flow elements first
229	8	50				30	if( $self->{module_flag} ) { 'scratch' }
	0	50				0
		50
		50
		50
		50
		50
230	0					0	elsif( $self->{in_U} ) { 'url_text' }
231	0					0	elsif( $self->{in_L} ) { 'link_text' }
232	0					0	elsif( $self->{in_output} ) { 'output_text' }
233	0					0	elsif( $self->{in_code} ) { 'code_text' }
234	0					0	elsif( $self->{in_terminal} ) { 'terminal_text' }
235	0					0	elsif( $self->{in_figure} ) { 'figure_text' }
236							# then block elements
237							# finally the default
238	8					9	else { 'scratch' }
239							}
240
241	3	50		3	0	6	sub get_from_current_pad ( $self ) {
	3	50				5
	3					1
	3					3
242	3					4	my $pad = $self->get_pad;
243	3					8	$self->{$pad};
244							}
245
246	0	0		0	0	0	sub add_to_current_pad ( $self, $text ) {
	0	0				0
	0					0
	0					0
	0					0
247	0					0	my $pad = $self->get_pad;
248	0					0	$self->{$pad} .= $text;
249							}
250
251	1	50		1	0	14	sub start_Document ( $self, $attributes={} ) {
	1	50				2
	1	50				1
	1					2
	1					1
252	1					2	$self->{in_section} = [];
253	1					3	$self->add_to_pad( $self->document_header );
254	1					3	$self->emit;
255							}
256
257	0	0		0	0	0	sub end_Document ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
258	0					0	$self->add_to_pad( $self->document_footer );
259	0					0	$self->emit;
260							}
261
262	1	50		1		2	sub _header_start ( $self, $level=1 ) {
	1	50				2
	1	50				1
	1					2
	1					1
263	1					1	$self->{in_header} = 1;
264	1					7	$self->add_html_tag( qq\|\| );
265							}
266	0	0		0		0	sub _header_end ( $self, $level=1 ) {
	0	0				0
	0	0				0
	0					0
	0					0
267	0					0	$self->{in_header} = 0;
268	0					0	$self->add_html_tag( "\n\n" );
269							}
270
271	1	50		1	0	11	sub start_head0 ( $self, $attributes={} ) { $self->_header_start( 0 ); }
	1	50				3
	1	50				1
	1					1
	1					2
	1					2
272	0	0		0	0	0	sub end_head0 ( $self, $attributes={} ) { $self->_header_end( 0 ); }
	0	0				0
	0	0				0
	0					0
	0					0
	0					0
273
274	0	0		0	0	0	sub end_head1 ( $self, $attributes={} ) { $self->_header_end( 1 ); }
	0	0				0
	0	0				0
	0					0
	0					0
	0					0
275	0	0		0	0	0	sub start_head1 ( $self, $attributes={} ) { $self->_header_start( 1 ); }
	0	0				0
	0	0				0
	0					0
	0					0
	0					0
276
277	0	0		0	0	0	sub end_head2 ( $self, $attributes={} ) { $self->_header_end( 2 ); }
	0	0				0
	0	0				0
	0					0
	0					0
	0					0
278	0	0		0	0	0	sub start_head2 ( $self, $attributes={} ) { $self->_header_start( 2 ); }
	0	0				0
	0	0				0
	0					0
	0					0
	0					0
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	0	0		0	0	0	sub end_non_code_text ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
285	0					0	$self->make_curly_quotes;
286
287	0					0	$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	0	0		0	0	0	sub start_Para ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
298	0	0				0	return if $self->{in_figure};
299	0					0	$self->add_html_tag( qq\| \| );
300
301	0					0	$self->escape_and_emit;
302
303	0					0	$self->{'in_para'} = 1;
304							}
305	0	0		0	0	0	sub end_Para ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
306	0	0				0	return if $self->{in_figure};
307	0					0	$self->add_html_tag( " \n\n" );
308
309	0					0	$self->end_non_code_text;
310
311	0					0	$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	0	0		0	1	0	sub start_Verbatim ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
323	0					0	$self->{'in_verbatim'} = 1;
324	0					0	my $sequence = ++$self->{'verbatim_sequence'};
325
326	0	0				0	if( $self->{'in_output'} ) {
		0
		0
327	0					0	$self->add_html_tag( qq\|\n\n \| );
328							}
329							elsif( $self->{'in_code'} ) {
330	0					0	$self->add_html_tag( qq\|\n\n `\| );`
331							}
332							elsif( $self->{'in_terminal'} ) {
333	0					0	$self->add_html_tag( qq\|\n\n `\| );`
334							}
335							else {
336	0					0	$self->add_html_tag( qq\|\n\n \| );
337							}
338
339	0					0	$self->emit;
340							}
341
342	0	0		0	1	0	sub end_Verbatim ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
343	0	0				0	if( $self->{'in_output'} ) {
		0
		0
344	0					0	$self->add_html_tag( qq\|\n\n\| );
345							}
346							elsif( $self->{'in_code'} ) {
347	0					0	$self->add_html_tag( qq\|\n\n\| );
348							}
349							elsif( $self->{'in_terminal'} ) {
350	0					0	$self->add_html_tag( qq\|\n\n\| );
351							}
352							else {
353	0					0	$self->add_html_tag( qq\|\n\n\| );
354							}
355
356	0					0	$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	0	0		0	1	0	sub start_output ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
369	0					0	$self->{'in_output'} = 1;
370							}
371	0	0		0	1	0	sub end_output ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
372	0					0	$self->{'in_output'} = 0;
373							}
374
375	0	0		0	0	0	sub start_code ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
376	0					0	$self->{'in_code'} = 1;
377							}
378	0	0		0	0	0	sub end_code ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
379	0					0	$self->{'in_code'} = 0;
380							}
381
382	0	0		0	0	0	sub start_terminal ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
383	0					0	$self->{'in_terminal'} = 1;
384							}
385	0	0		0	0	0	sub end_terminal ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
386	0					0	$self->{'in_terminal'} = 0;
387							}
388
389	0	0		0	0	0	sub start_figure ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
390	0					0	$self->{in_figure} = 1;
391	0					0	$self->{figure_title} = $attributes->{title};
392
393	0					0	my $pad = $self->get_pad;
394							}
395
396							sub end_figure {
397	0			0	0	0	my( $self, $flags ) = @_;
398
399	0					0	my $pad = $self->get_pad;
400	0					0	my $filename = $self->{$pad};
401	0					0	$self->clear_pad;
402
403	0					0	$self->add_html_tag(
404							"\n\n" .
405							qq( ) .
406							"\n\n"
407
408							);
409
410	0					0	$self->{figure_title} = 0;
411	0					0	$self->{in_figure} = 0;
412							}
413
414	0	0		0		0	sub _get_initial_item_type ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
415	0					0	my $type = $self->SUPER::_get_initial_item_type;
416
417	0					0	$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	0	0		0	0	0	sub add_list_level_item ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
424	0					0	${ $self->{list_levels} }[-1]{item_count}++;
	0					0
425							}
426	0	0		0	0	0	sub is_first_list_level_item ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
427	0					0	${ $self->{list_levels} }[-1]{item_count} == 0;
	0					0
428							}
429
430	0	0		0	0	0	sub start_list_level ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
431	0					0	push @{ $self->{list_levels} }, { item_count => 0 };
	0					0
432							}
433
434	0	0		0	0	0	sub end_list_level ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
435	0					0	pop @{ $self->{list_levels} };
	0					0
436							}
437
438	0	0		0	0	0	sub start_item_bullet ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
439							#print STDERR Dumper($self->{list_levels}), "\n"; use Data::Dumper;
440	0	0				0	$self->add_html_tag( "\n\n" )
441							unless $self->is_first_list_level_item;
442	0					0	$self->add_list_level_item;
443	0					0	$self->add_html_tag( " \n" );
444	0					0	$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	0	0		0	0	0	sub end_item_bullet ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
454	0					0	$self->end_Para;
455							# $self->add_to_pad( "\n\n" );
456	0					0	$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	0	0		0	0	0	sub start_over_bullet ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
463	0					0	$self->add_html_tag( qq( ) );
464	0					0	$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	0	0		0	0	0	sub end_over_bullet ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
472	0					0	$self->{last_thingy} = 'item_list';
473	0					0	$self->end_non_code_text;
474	0					0	$self->add_html_tag( "\n\n" );
475
476							# $self->add_to_pad( "\n\n" ); XXX: WTF?
477	0					0	$self->end_list_level;
478	0					0	$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	0	0		0	0	0	sub end_B ( $self, $attributes={} ) { $self->add_html_tag( '' ); $self->{in_B} = 0; }
	0	0				0
	0	0				0
	0					0
	0					0
	0					0
	0					0
497	0	0		0	0	0	sub start_B ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
498	0					0	$self->add_html_tag( '`' );`
499	0					0	$self->{in_B} = 1;
500							}
501
502	0	0		0	0	0	sub end_C ( $self, $attributes={} ) { $self->add_html_tag( '' ); $self->{in_C} = 0; }
	0	0				0
	0	0				0
	0					0
	0					0
	0					0
	0					0
503	0	0		0	0	0	sub start_C ( $self, $attributes={} ) { $self->add_html_tag( '`' ); $self->{in_C} = 1; }`
	0	0				0
	0	0				0
	0					0
	0					0
	0					0
	0					0
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	0	0		0	0	0	sub end_I ( $self, $attributes={} ) { $self->add_html_tag( '' ) }
	0	0				0
	0	0				0
	0					0
	0					0
	0					0
509	0	0		0	0	0	sub start_I ( $self, $attributes={} ) { $self->add_html_tag( '' ) }
	0	0				0
	0	0				0
	0					0
	0					0
	0					0
510
511							# keyword
512	0	0		0	0	0	sub end_K ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
513	0					0	my $text = $self->get_from_current_pad;
514	0					0	$self->clear_pad;
515	0					0	my $link = do {
516							## what if it isn't a keyword??? XXX
517	0					0	"http://perldoc.perl.org/function/$text.html"
518							};
519
520	0					0	$self->add_html_tag( qq\|\| );
521	0					0	$self->add_to_pad( $text );
522	0					0	$self->add_html_tag( '' );
523	0					0	$self->emit;
524	0					0	$self->{in_K} = 0;
525							}
526
527	0	0		0	0	0	sub start_K ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
528	0					0	$self->emit;
529	0					0	$self->{in_K} = 1;
530							}
531
532	0	0		0	0	0	sub end_L ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
533	0					0	my $text = $self->get_from_current_pad;
534	0					0	$self->clear_pad;
535	0					0	my $link = do {
536	0	0				0	if( $text =~ /\A(perl[a-z0-9]+)\z/ ) { "http://perldoc.perl.org/$1.html" }
	0					0
537							};
538
539	0					0	$self->add_html_tag( qq\|\| );
540	0					0	$self->add_to_pad( $text );
541	0					0	$self->add_html_tag( '' );
542	0					0	$self->emit;
543	0					0	$self->{in_L} = 0;
544							}
545	0	0		0	0	0	sub start_L ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
546	0					0	$self->emit;
547	0					0	$self->{in_L} = 1;
548							}
549
550	0	0		0	0	0	sub start_M ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
551	0					0	$self->emit;
552	0					0	$self->{'module_flag'} = 1;
553	0					0	$self->{'module_text'} = '';
554							}
555	0	0		0	0	0	sub end_M ( $self, $attributes={} ) {
	0	0				0
	0	0				0
	0					0
	0					0
556	0					0	my $text = $self->get_from_current_pad;
557	0					0	$self->clear_pad;
558
559	0					0	my $href = "https://www.metacpan.org/module/$text";
560
561	0					0	$self->add_html_tag( qq() );
562	0					0	$self->add_to_pad( $text );
563	0					0	$self->add_html_tag( '' );
564	0					0	$self->clear_pad;
565
566	0					0	$self->{'module_flag'} = 0;
567							}
568
569	0	0		0	0	0	sub start_T ( $self, $attributes={} ) { $self->add_html_tag( '' ) }
	0	0				0
	0	0				0
	0					0
	0					0
	0					0
570	0	0		0	0	0	sub end_T ( $self, $attributes={} ) { $self->add_html_tag( '' ) }
	0	0				0
	0	0				0
	0					0
	0					0
	0					0
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	1	50		1	0	18	sub handle_text ( $self, $text ) {
	1	50				2
	1					1
	1					1
	1					1
583	1					1	my $pad = $self->get_pad;
584
585	1					2	$self->escape_text( \$text );
586	1					1	$self->{$pad} .= $text;
587
588	1	50				2	unless( $self->dont_escape ) {
589	1					2	$self->make_curly_quotes;
590	0					0	$self->make_em_dashes;
591	0					0	$self->make_ellipses;
592							}
593							}
594
595	1	50		1	0	3	sub dont_escape ( $self ) {
	1	50				2
	1					1
	1					1
596	1	50				4	$self->{in_verbatim} \|\| $self->{in_C}
597							}
598
599	1	50		1	0	22	sub escape_text ( $self, $text_ref ) {
	1	50				2
	1					1
	1					1
	1					1
600	1					2	$$text_ref =~ s/&/&/g;
601	1					2	$$text_ref =~ s/
602
603	1					1	return 1;
604							}
605
606	1	50		1	0	2	sub make_curly_quotes ( $self ) {
	1	50				2
	1					1
	1					1
607	1					1	my $text = $self->get_from_current_pad;
608
609	1					231	require Tie::Cycle;
610
611	0					0	tie my $cycle, 'Tie::Cycle', [ qw( “ ” ) ];
612
613	0					0	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	0					0	$text =~ s/'/’/g;
619
620	0					0	$self->clear_pad;
621	0					0	$self->add_to_current_pad( $text );
622
623	0					0	return 1;
624							}
625
626	0	0		0	0	0	sub make_em_dashes ( $self ) {
	0	0				0
	0					0
	0					0
627	0					0	my $pad = $self->get_pad;
628	0					0	$self->{$pad} =~ s/--/—/g;
629	0					0	return 1;
630							}
631
632	0	0		0	0	0	sub make_ellipses ( $self ) {
	0	0				0
	0					0
	0					0
633	0					0	my $pad = $self->get_pad;
634	0					0	$self->{$pad} =~ s/\Q.../…/g;
635	0					0	return 1;
636							}
637
638							BEGIN {
639	1			1		261	require Pod::Simple::BlackBox;
640
641							package Pod::Simple::BlackBox;
642
643	0	0		0		0	sub _ponder_Verbatim ( $self, $para ) {
	0	0				0
	0					0
	0					0
	0					0
644	0					0	DEBUG and print STDERR " giving verbatim treatment...\n";
645
646	0					0	$para->[1]{'xml:space'} = 'preserve';
647	0					0	foreach my $line ( @$para[ 2 .. $#$para ] ) {
648	0					0	$line =~ s/\A(\t\| )//gm;
649	0					0	$line =~ s/\A(\t+)/" " x ( 4 * length($1) )/e;
	0					0
650	0	0				0	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	0	0	0			0	if( $self->{'accept_codes'} and
		0
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	0	0				0	push @$para, join "\n", splice(@$para, 2) if @$para > 3;
674	0					0	$para->[-1] =~ s/\n+$//s; # Kill any number of terminal newlines
675							}
676	0					0	return;
677							}
678
679							}
680
681	1			1		1274	BEGIN {
682
683							# override _treat_Es so I can localize e2char
684							sub _treat_Es {
685	0			0		0	my $self = shift;
686
687	0					0	require Pod::Escapes;
688	0					0	local Pod::Escapes::e2char = e2char_tagged_text;
689
690	0					0	$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	2	50		2		2566	sub _ponder_paragraph_buffer ( $self ) {
	2	50				4
	2					2
	2					1
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	2					1	my $paras;
783	2	100				1	return unless @{$paras = $self->{'paras'}};
	2					6
784	1		50			6	my $curr_open = ($self->{'curr_open'} \|\|= []);
785
786	1	50				4	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	1	50				2	unless($self->{'doc_has_started'}) {
790	1					1	$self->{'doc_has_started'} = 1;
791
792	1					1	my $starting_contentless;
793	1		33			7	$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				8	$self->_handle_element_start('Document',
806							{
807							'start_line' => $paras->[0][1]{'start_line'},
808							$starting_contentless ? ( 'contentless' => 1 ) : (),
809							},
810							);
811							}
812
813	1					2	my($para, $para_type);
814	1					6	while(@$paras) {
815	1	50	33			12	last if @$paras == 1 and
			33
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	1					2	$para = shift @$paras;
829	1					1	$para_type = $para->[0];
830
831	1	50				1	DEBUG > 1 and print "Pondering a $para_type paragraph, given the stack: (",
832							$self->_dump_curr_open(), ")\n";
833
834	1	50				5	if($para_type eq '=for') {
		50
		50
		50
835	0	0				0	next if $self->_ponder_for($para,$curr_open,$paras);
836							} elsif($para_type eq '=begin') {
837	0	0				0	next if $self->_ponder_begin($para,$curr_open,$paras);
838							} elsif($para_type eq '=end') {
839	0	0				0	next if $self->_ponder_end($para,$curr_open,$paras);
840							} elsif($para_type eq '~end') { # The virtual end-document signal
841	0	0				0	next if $self->_ponder_doc_end($para,$curr_open,$paras);
842							}
843
844
845							# ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
846							#~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
847	1	50				2	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	1	50				6	if($para_type eq '=pod') {
		50
		50
		50
		50
		50
856	0					0	$self->_ponder_pod($para,$curr_open,$paras);
857							} elsif($para_type eq '=over') {
858	0	0				0	next if $self->_ponder_over($para,$curr_open,$paras);
859							} elsif($para_type eq '=back') {
860	0	0				0	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	1	50				1	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	1	50	33			6	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	1	50	33			9	if($para_type =~ m/^=head\d$/s
			33
			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	1	50	33			14	if($para_type eq '=item') {
		50
		50
		50
		50
		50
		50
902	0	0				0	next if $self->_ponder_item($para,$curr_open,$paras);
903	0					0	$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	0					0	$para->[0] = 'Verbatim';
917	0					0	$para_type = '?Verbatim';
918							} elsif($para_type eq '~Para') {
919	0					0	$para->[0] = 'Para';
920	0					0	$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	1	50				2	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	1	50				1	DEBUG > 1 and print "para_type is $para_type\n";
943	1	50				4	if($para_type =~ s/^\?//s) {
944	0	0				0	if(! @$curr_open) { # usual case
945	0	0				0	DEBUG and print "Treating $para_type paragraph as such because stack is empty.\n";
946							} else {
947	0					0	my @fors = grep $_->[0] eq '=for', @$curr_open;
948	0	0				0	DEBUG > 1 and print "Containing fors: ",
949							join(',', map $_->[1]{'target'}, @fors), "\n";
950
951	0	0				0	if(! @fors) {
		0
952	0	0				0	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	0	0				0	DEBUG and print "~resolve is $fors[-1][1]{'~resolve'}\n";
959
960	0	0				0	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	0	0				0	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	1	50				2	if($para_type eq 'Plain') {
		0
		0
976	1					28	$self->_ponder_Plain($para);
977							} elsif($para_type eq 'Verbatim') {
978	0					0	$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	1					77	$para->[0] =~ s/^[~=]//s;
988
989	1	50				2	DEBUG and print "\n", Pod::Simple::BlackBox::pretty($para), "\n";
990
991							# traverse the treelet (which might well be just one string scalar)
992	1		50			4	$self->{'content_seen'} \|\|= 1;
993	1					6	$self->_traverse_treelet_bit(@$para);
994							}
995							}
996
997	0						return;
998							}
999
1000							1;