Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

Comparing changes

Choose two branches to see what's changed or to start a new pull request. If you need to, you can also compare across forks.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also compare across forks.
base fork: chromatic/pod-pseudopod-dom
base: 1eaeb79173
...
head fork: chromatic/pod-pseudopod-dom
compare: 563917664f
Checking mergeability… Don't worry, you can still create the pull request.
  • 15 commits
  • 22 files changed
  • 0 commit comments
  • 1 contributor
View
46 lib/Pod/PseudoPod/DOM.pm
@@ -100,6 +100,40 @@ sub end_Document
{
my $self = shift;
$self->{active_elements} = [];
+ $self->finish_document;
+}
+
+sub finish_document
+{
+ my $self = shift;
+ $self->collapse_index_entries;
+}
+
+sub collapse_index_entries
+{
+ my $self = shift;
+ my $document = $self->get_document;
+ my $kids = $document->children;
+ my @saved_kids;
+ my @splice_kids;
+
+ # merge index entries into the next paragraph with visible text
+ for my $kid (@$kids)
+ {
+ if ($kid->type eq 'paragraph')
+ {
+ unless ($kid->has_visible_kids)
+ {
+ push @splice_kids, @{ $kid->children };
+ next;
+ }
+ unshift @{ $kid->children }, splice @splice_kids;
+ }
+
+ push @saved_kids, $kid;
+ }
+
+ @$kids = @saved_kids;
}
sub start_Verbatim
@@ -194,19 +228,17 @@ BEGIN
my $start_meth = sub
{
my $self = shift;
- $self->push_heading_element(
- Heading => level => $heading, type => 'header'
+ $self->push_heading_element( Heading =>
+ level => $heading,
+ type => 'header',
+ filename => $self->{basefile},
);
};
my $end_meth = sub
{
my $self = shift;
- my $head = $self->reset_to_item( Heading => level => $heading );
-
- $self->start_Z;
- $self->handle_text( $head->emit_kids( encode => 'index_anchor' ) );
- $self->end_Z;
+ $self->reset_to_item( Heading => level => $heading );
};
do
View
29 lib/Pod/PseudoPod/DOM/App/ToHTML.pm
@@ -12,16 +12,17 @@ use Pod::PseudoPod::DOM::App qw( open_fh );
sub process_files_with_output
{
+ my ($role, @files) = process_args( @_ );
my @docs;
my %anchors;
my $corpus = Pod::PseudoPod::DOM::Corpus->new;
- for my $file (@_)
+ for my $file (@files)
{
my ($source, $output) = @$file;
my $parser = Pod::PseudoPod::DOM->new(
- formatter_role => 'Pod::PseudoPod::DOM::Role::XHTML',
+ formatter_role => $role,
formatter_args => { add_body_tags => 1, anchors => \%anchors },
filename => $output,
);
@@ -43,4 +44,28 @@ sub process_files_with_output
$corpus->write_toc;
}
+sub process_args
+{
+ my @files;
+ my $role = 'html';
+ my %roles = ( html => 'HTML', epub => 'EPUB' );
+
+ for my $arg (@_)
+ {
+ if ($arg =~ /^--(\w+)=(\w+)/)
+ {
+ if ($1 eq 'role')
+ {
+ $role = exists $roles{$2} ? $roles{$2} : $role;
+ };
+ }
+ else
+ {
+ push @files, $arg;
+ }
+ }
+
+ return "Pod::PseudoPod::DOM::Role::$role", @files;
+}
+
1;
View
2  lib/Pod/PseudoPod/DOM/Corpus.pm
@@ -74,7 +74,7 @@ sub write_documents
sub write_index
{
my $self = shift;
- my $outfh = $self->get_fh_in_path( 'book_index', '>' );
+ my $outfh = $self->get_fh_in_path( 'theindex', '>' );
print {$outfh} $self->get_index;
}
View
22 lib/Pod/PseudoPod/DOM/Elements.pm
@@ -13,7 +13,8 @@ use Moose;
with 'MooseX::Traits';
has 'type', is => 'ro', required => 1;
- sub is_empty { 1 }
+ sub is_empty { 1 }
+ sub is_visible { 1 }
}
{
@@ -45,6 +46,12 @@ use Moose;
use Moose;
extends 'Pod::PseudoPod::DOM::ParentElement';
+
+ sub has_visible_kids
+ {
+ my $self = shift;
+ return grep { $_->is_visible } @{ $self->children };
+ }
}
{
@@ -61,7 +68,8 @@ use Moose;
$self->content( shift );
}
- sub is_empty { length( shift->content ) == 0 }
+ sub is_visible { shift->content =~ /\S/ }
+ sub is_empty { length( shift->content ) == 0 }
}
{
@@ -82,8 +90,7 @@ use Moose;
extends 'Pod::PseudoPod::DOM::Element::Linkable';
- # XXX: this shouldn't be here
- sub get_filename { shift->link }
+ sub is_visible { 0 }
sub get_anchor { shift->emit_kids( encode => 'index_anchor' ) }
sub get_link_text { shift->heading->emit_kids }
}
@@ -96,6 +103,8 @@ use Moose;
extends 'Pod::PseudoPod::DOM::Element::Linkable';
+ sub is_visible { 0 }
+
sub get_key
{
my $self = shift;
@@ -133,8 +142,9 @@ use Moose;
extends 'Pod::PseudoPod::DOM::ParentElement';
- has 'level', is => 'ro', required => 1;
- has 'anchor', is => 'rw';
+ has 'level', is => 'ro', required => 1;
+ has 'anchor', is => 'rw';
+ has 'filename', is => 'ro', required => 1;
sub exclude_from_toc
{
View
14 lib/Pod/PseudoPod/DOM/Index.pm
@@ -29,7 +29,7 @@ sub get_top_entry
{
my ($self, $key) = @_;
my $entries = $self->entries;
- my ($top_key) = $key =~ /(\w)/;
+ my $top_key = $key =~ /(\w)/ ? $1 : substr $key, 0, 1;
return $entries->{uc $top_key}
||= Pod::PseudoPod::DOM::Index::TopEntryList->new( key => uc $top_key );
}
@@ -39,12 +39,17 @@ sub emit_index
my $self = shift;
my $entries = $self->entries;
my $heading = <<END_HTML_HEAD;
-<html>
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
+ "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head>
+<title></title>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<link rel="stylesheet" href="../css/style.css" type="text/css" />
</head>
<body>
-<h1 id="index"><a name="index"></a>Index</h1>
+<h1 id="index">Index</h1>
END_HTML_HEAD
my $footer = <<END_HTML_FOOTER;
@@ -211,13 +216,14 @@ use strict;
use warnings;
use Moose;
+use HTML::Entities;
extends 'Pod::PseudoPod::DOM::Index::EntryList';
sub emit
{
my $self = shift;
- my $key = $self->key;
+ my $key = encode_entities( $self->key );
return qq|<h2>$key</h2>\n\n| . $self->emit_contents;
}
View
52 lib/Pod/PseudoPod/DOM/Role/EPUB.pm
@@ -0,0 +1,52 @@
+package Pod::PseudoPod::DOM::Role::EPUB;
+# ABSTRACT: an EPUB XHTML formatter role for PseudoPod DOM trees
+
+use strict;
+use warnings;
+
+use Moose::Role;
+
+with 'Pod::PseudoPod::DOM::Role::HTML' =>
+{
+ -excludes => [qw( emit_anchor emit_index emit_body )],
+};
+
+sub emit_anchor
+{
+ my $self = shift;
+ my $anchor = $self->get_anchor;
+
+ return qq|<div id="$anchor" />|;
+}
+
+sub emit_index
+{
+ my $self = shift;
+
+ my $content = $self->get_anchor;
+ $content .= $self->id if $self->type eq 'index';
+
+ return qq|<div id="$content" />|;
+}
+
+sub emit_body
+{
+ my $self = shift;
+ return <<END_HTML_HEAD . $self->emit_kids( @_ ) . <<END_HTML;
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
+ "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
+<head>
+<title></title>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
+<link rel="stylesheet" href="../css/style.css" type="text/css" />
+</head>
+<body>
+END_HTML_HEAD
+</body>
+</html>
+END_HTML
+}
+
+1;
View
58 lib/Pod/PseudoPod/DOM/Role/XHTML.pm → lib/Pod/PseudoPod/DOM/Role/HTML.pm
@@ -1,25 +1,38 @@
-package Pod::PseudoPod::DOM::Role::XHTML;
-# ABSTRACT: an XHTML formatter role for PseudoPod DOM trees
+package Pod::PseudoPod::DOM::Role::HTML;
+# ABSTRACT: an HTML formatter role for PseudoPod DOM trees
use strict;
use warnings;
use Moose::Role;
+
use HTML::Entities;
use Scalar::Util 'blessed';
+use MIME::Base64 'encode_base64url';
requires 'type';
has 'add_body_tags', is => 'ro', default => 0;
has 'emit_environments', is => 'ro', default => sub { {} };
has 'anchors', is => 'rw', default => sub { {} };
+sub get_anchor
+{
+ my $self = shift;
+ my $anchor = $self->emit_kids( encode => 'index_anchor' );
+ return encode_base64url( $anchor );
+}
+
sub get_link_for_anchor
{
my ($self, $anchor) = @_;
my $anchors = $self->anchors;
return unless my $heading = $anchors->{$anchor};
- return map { $heading->$_ } qw( get_filename get_anchor get_link_text );
+ my $filename = $heading->link;
+ my $target = $heading->get_anchor;
+ my $title = $heading->get_link_text;
+
+ return $filename, $target, $title;
}
sub resolve_anchors
@@ -68,7 +81,7 @@ my %characters = (
sub emit_character
{
my ($self, %args) = @_;
- my $content = eval { $self->emit_kids( %args ) };
+ my $content = eval { $self->emit_kids };
return '' unless defined $content;
@@ -77,7 +90,10 @@ sub emit_character
return $characters{$class}->($char) if exists $characters{$class};
}
+ $args{encode} ||= '';
my $char = Pod::Escapes::e2char( $content );
+ return $char if $args{encode} =~ /^(index_|id$)/;
+
return $self->handle_encoding( $char );
}
@@ -157,11 +173,11 @@ sub get_heading_link
my ($self, %args) = @_;
my $content = $self->emit_kids;
- my $filename = $self->anchor->link || $args{filename};
- my $href = $self->emit_kids( encode => 'index_anchor' );
+ my $filename = $self->filename || '';
+ my $frag = 'toc_' . $self->get_anchor;
$content =~ s/^\*//;
- return qq|<a href="$filename#$href">$content</a>|;
+ return qq|<a href="$filename#$frag">$content</a>|;
}
sub emit_body
@@ -193,9 +209,9 @@ sub emit_header
my $id = $self->emit_kids( encode => 'id' );
my $no_toc = $content =~ s/^\*//;
my $level = 'h' . ($self->level + 1);
- my $header = qq|<$level id="$id">$content</$level>\n\n|;
+ my $anchor = $no_toc ? '' : $self->emit_index( @_ );
- return $no_toc ? $header : $self->emit_index( @_ ) . $header;
+ return qq|<$level id="$id">$anchor$content</$level>\n\n|;
}
sub emit_plaintext
@@ -233,6 +249,11 @@ sub encode_text
{
my ($self, $text) = @_;
+ use Carp;
+ unless (defined $text)
+ {
+ confess 'no text';
+ }
$text = encode_entities($text);
$text =~ s/\s*---\s*/&#8213;/g;
$text =~ s/\s*--\s*/&mdash;/g;
@@ -254,7 +275,6 @@ sub encode_index_anchor
$text =~ s/^\*//;
$text =~ s/[\s"]//g;
- $text = encode_entities($text);
return $text;
}
@@ -300,9 +320,7 @@ sub emit_literal
sub emit_anchor
{
my $self = shift;
- return qq|<a name="|
- . $self->emit_kids( encode => 'index_anchor' )
- . qq|"></a>|;
+ return qq|<a name="| . $self->get_anchor . qq|"></a>|;
}
sub emit_number_item
@@ -482,8 +500,7 @@ sub make_block_title
sub emit_index
{
my $self = shift;
-
- my $content = $self->emit_kids( encode => 'index_anchor' );
+ my $content = $self->get_anchor;
$content .= $self->id if $self->type eq 'index';
return qq|<a name="$content"></a>|;
@@ -491,12 +508,11 @@ sub emit_index
sub emit_index_link
{
- my $self = shift;
- my $id = $self->id;
- my $content = $self->emit_kids( encode => 'index_anchor' ) . $id;
- my $file = $self->link;
-
- return qq|<a href="$file#$content">$id</a>|;
+ my $self = shift;
+ my $id = $self->id;
+ my $frag = $self->get_anchor . $id;
+ my $file = $self->link;
+ return qq|<a href="$file#$frag">$id</a>|;
}
sub emit_table
View
31 t/html/basic.t
@@ -3,39 +3,41 @@ use warnings;
use Test::More;
use lib 't/lib';
-use TestDOM 'Pod::PseudoPod::DOM::Role::XHTML';
+use TestDOM 'Pod::PseudoPod::DOM::Role::HTML';
use_ok('Pod::PseudoPod::DOM') or exit;
my $parser = Pod::PseudoPod::DOM->new(
- formatter_role => 'Pod::PseudoPod::DOM::Role::XHTML'
+ formatter_role => 'Pod::PseudoPod::DOM::Role::HTML'
);
isa_ok $parser, 'Pod::PseudoPod::DOM';
my $result = parse( "=head0 Narf!" );
-like $result, qr|<a name="Narf!"></a><h1 id="narf">Narf!</h1>\n\n|,
+my $link = encode_link( 'Narf!' );
+like $result, qr|<h1 id="narf"><a name="$link"></a>Narf!</h1>\n\n|,
"head0 level output";
$result = parse( "=head1 Poit!" );
-like $result, qr|<a name="Poit!"></a><h2 id="poit">Poit!</h2>\n\n|,
+$link = encode_link( 'Poit!' );
+like $result, qr|<h2 id="poit"><a name="$link"></a>Poit!</h2>\n\n|,
"head1 level output";
$result = parse( "=head2 I think so Brain." );
+$link = encode_link( 'IthinksoBrain.' );
like $result,
- qr|<a name="IthinksoBrain."></a><h3 id="ithinksobrain">I think so Brain.</h3>\n\n|,
+ qr|<h3 id="ithinksobrain"><a name="$link"></a>I think so Brain.</h3>\n\n|,
"head2 level output";
$result = parse( "=head3 I say, Brain..." );
-like $result,
- qr|<a name="Isay,Brain..."></a><h4 id="isaybrain">I say, Brain...</h4>\n\n|,
+$link = encode_link( 'Isay,Brain...' );
+like $result, qr|<h4 id="isaybrain"><a name="$link"></a>I say, Brain...</h4>\n|,
"head3 level output";
$result = parse( "=head4 Zort!" );
-like $result,
- qr|<a name="Zort!"></a><h5 id="zort">Zort!</h5>\n\n|,
+$link = encode_link( 'Zort!' );
+like $result, qr|<h5 id="zort"><a name="$link"></a>Zort!</h5>\n\n|,
"head4 level output";
-
$result = parse( <<'EOPOD' );
=pod
@@ -226,8 +228,10 @@ $result = parse( <<'EOPOD' );
A plain paragraph with a Z<crossreferenceendpoint>.
EOPOD
-is($result, <<"EOHTML", "Link anchor entity in a paragraph");
-<p>A plain paragraph with a <a name="crossreferenceendpoint"></a>.</p>
+
+$link = encode_link( 'crossreferenceendpoint' );
+is $result, <<"EOHTML", 'Link anchor entity in a paragraph';
+<p>A plain paragraph with a <a name="$link"></a>.</p>
EOHTML
@@ -243,8 +247,9 @@ Z<crossreferencelink>
A plain paragraph with a A<crossreferencelink>.
EOPOD
+$link = encode_link( 'crossreferencelink' );
like $result,
- qr!paragraph with a <a href="basic.t.pod#crossreferencelink">XREF header<!,
+ qr!paragraph with a <a href="basic.t.pod#$link">XREF header</a>!,
'Link entity in a paragraph';
$result = parse( <<'EOPOD' );
View
2  t/html/emit_environments.t
@@ -5,7 +5,7 @@ use Test::More;
use Test::LongString;
use lib 't/lib';
-use TestDOM 'Pod::PseudoPod::DOM::Role::XHTML';
+use TestDOM 'Pod::PseudoPod::DOM::Role::HTML';
use File::Slurp;
use File::Spec::Functions;
View
2  t/html/environments.t
@@ -5,7 +5,7 @@ use Test::More;
use Test::LongString;
use lib 't/lib';
-use TestDOM 'Pod::PseudoPod::DOM::Role::XHTML';
+use TestDOM 'Pod::PseudoPod::DOM::Role::HTML';
use File::Slurp;
use File::Spec::Functions;
View
41 t/html/escapes.t
@@ -5,7 +5,7 @@ use Test::More;
use Test::LongString;
use lib 't/lib';
-use TestDOM 'Pod::PseudoPod::DOM::Role::XHTML';
+use TestDOM 'Pod::PseudoPod::DOM::Role::HTML';
use File::Spec::Functions;
use File::Slurp;
@@ -59,37 +59,48 @@ like_string $result, qr/ineffable/, 'ff ligature also gets no marking';
like_string $result, qr/ligatures&mdash;and/,
'spacey double dash should become a real emdash';
-like_string $result, qr/<a name="negation!operator1">/,
- '! is fine as-is in index anchor';
+my $link = encode_link( 'negation!operator' );
+like_string $result, qr/<a name="${link}1">/,
+ '! needs URI encoding in index anchor';
-like_string $result, qr/<a name="array\@sigil1">/,
- '@ is also fine as-is in index anchor';
+$link = encode_link( 'array@sigil' );
+like_string $result, qr/<a name="${link}1">/,
+ '@ needs URI encoding in index anchor';
-like_string $result, qr/<a name="thepipe|1">/,
+$link = encode_link( 'thepipe|' );
+like_string $result, qr/<a name="${link}1">/,
'spaces removed from index anchors';
-like_string $result, qr/<a name="strangequoteaa1">/,
+$link = encode_link( 'strangequoteaa' );
+like_string $result, qr/<a name="${link}1">/,
'quotes removed from index anchors';
-like_string $result, qr/<a name="\$\^W;carats1">/,
- '... carat gets no special treatment in anchor';
+$link = encode_link( '$^W;carats' );
+like_string $result, qr/<a name="${link}1">/,
+ '... carat needs URI encoding in anchor';
-like_string $result, qr/<a name="hierarchicalterms;omittingtrailingspaces1">/,
+$link = encode_link( 'hierarchicalterms;omittingtrailingspaces' );
+like_string $result, qr/<a name="${link}1">/,
'trailing spaces in hierarchical terms should be ignored';
-like_string $result, qr/<a name="codeanditalicstext1">/,
+$link = encode_link( 'codeanditalicstext' );
+like_string $result, qr/<a name="${link}1">/,
'... and code/italics formatting';
-like_string $result, qr/<a name="&lt;=&gt;;numericcomparisonoperator1">/,
+$link = encode_link( '<=>;numericcomparisonoperator' );
+like_string $result, qr/<a name="${link}1">/,
'... and should escape <> symbols';
-like_string $result, qr/<a name="sigils;&amp;1">/,
+$link = encode_link( 'sigils;&' );
+like_string $result, qr/<a name="${link}1">/,
'... in index anchors as well';
-like_string $result, qr/<a name="\.tfiles1">/,
+$link = encode_link( '.tfiles' );
+like_string $result, qr/<a name="${link}1">/,
'... and should suppress HTML tags in index anchors';
-like_string $result, qr/<a name="operators;&lt;1">/,
+$link = encode_link( 'operators;<' );
+like_string $result, qr/<a name="${link}1">/,
'... encoding entities as necessary';
like_string $result, qr/<code>&lt;=&gt;<\/code>/,
View
4 t/html/extra_tags.t
@@ -3,12 +3,12 @@ use warnings;
use Test::More;
use lib 't/lib';
-use TestDOM 'Pod::PseudoPod::DOM::Role::XHTML';
+use TestDOM 'Pod::PseudoPod::DOM::Role::HTML';
use_ok('Pod::PseudoPod::DOM') or exit;
my $parser = Pod::PseudoPod::DOM->new(
- formatter_role => 'Pod::PseudoPod::DOM::Role::XHTML'
+ formatter_role => 'Pod::PseudoPod::DOM::Role::HTML'
);
isa_ok $parser, 'Pod::PseudoPod::DOM';
View
5 t/html/figures.t
@@ -5,7 +5,7 @@ use Test::More;
use Test::LongString;
use lib 't/lib';
-use TestDOM 'Pod::PseudoPod::DOM::Role::XHTML';
+use TestDOM 'Pod::PseudoPod::DOM::Role::HTML';
use File::Spec::Functions;
use File::Slurp;
@@ -14,7 +14,8 @@ use_ok( 'Pod::PseudoPod::DOM' ) or exit;
my $file = read_file( catfile( qw( t test_file.pod ) ) );
my ($doc, $result) = parse_with_anchors( $file );
-like_string $result, qr/<p><a name="figure_link">/,
+my $link = encode_link( 'figure_link' );
+like_string $result, qr/<p><a name="$link">/,
'figure should start a figure environment';
like_string $result, qr!<img src="some/path/to/image_file.png"!,
'... without quoting image file paths';
View
2  t/html/lists.t
@@ -5,7 +5,7 @@ use Test::More;
use Test::LongString;
use lib 't/lib';
-use TestDOM 'Pod::PseudoPod::DOM::Role::XHTML';
+use TestDOM 'Pod::PseudoPod::DOM::Role::HTML';
use File::Spec::Functions;
use File::Slurp;
View
20 t/html/nested.t
@@ -2,13 +2,15 @@ use strict;
use warnings;
use Test::More;
+use Test::LongString;
+
use lib 't/lib';
-use TestDOM 'Pod::PseudoPod::DOM::Role::XHTML';
+use TestDOM 'Pod::PseudoPod::DOM::Role::HTML';
use_ok('Pod::PseudoPod::DOM') or exit;
my $parser = Pod::PseudoPod::DOM->new(
- formatter_role => 'Pod::PseudoPod::DOM::Role::XHTML'
+ formatter_role => 'Pod::PseudoPod::DOM::Role::HTML'
);
isa_ok $parser, 'Pod::PseudoPod::DOM';
@@ -47,18 +49,22 @@ Is it not nifty?
END_POD
-like $result, qr!<h1 id="sometitle">Some Title</h1>!, '=head0 to <h1> title';
+my $link = encode_link( 'SomeTitle' );
+like $result, qr!<h1 id="sometitle"><a name="$link"></a>Some Title</h1>!,
+ '=head0 to <h1> title';
+$link = encode_link( 'SomeTitlewithCodeandEmphasizedandBold' );
like $result,
- qr!<h2 id="sometitlewithcodeand.+">Some Title with <code>Code</code>!,
+ qr!<h2 id="sometitlewithcodeand.+"><a name="$link"></a>Some Title with <code>Code</code>!,
'C<> tag nested in =headn';
-like $result, qr!<h2 id="someti.+andemph.+">Some Title.+?<em>Emphasized</em>!,
+like $result, qr!<h2 id="someti.+andemp.+">.+?Some Title.+?<em>Emphasized</em>!,
'I<> tag nested in =headn';
-like $result, qr!<h2 id="someti.+andbold">Some Title.+?<strong>Bold</strong>!,
+like $result, qr!<h2 id="somet.+andbold">.+?Some Title.+?<strong>Bold</strong>!,
'B<> tag nested in =headn';
+$link = encode_link( 'AHeaderNestedinaSidebar' );
like $result,
- qr|<div class="sidebar">[^>]+<a name="AHeade.+"></a><h3 id="ahe.+">A Head|,
+ qr|<div class="sidebar">[^>]+<h3 id="ahe.+"><a name="$link"></a>A Head|,
'=headn nested in sidebar';
like $result, qr!<ul>[^>]+<li>One.*</div>!s,
View
30 t/html/sections.t
@@ -7,7 +7,7 @@ use Test::More;
use Test::LongString;
use lib 't/lib';
-use TestDOM 'Pod::PseudoPod::DOM::Role::XHTML';
+use TestDOM 'Pod::PseudoPod::DOM::Role::HTML';
use Pod::PseudoPod::DOM::App;
use File::Spec::Functions;
use File::Slurp;
@@ -18,35 +18,43 @@ my %anchors;
my $file = read_file( catfile( qw( t test_file.pod ) ) );
my $result = parse_with_anchors( $file );
-like_string $result, qr!<h1 id="somedocument">Some Document</h1>!,
+my $link = encode_link( 'SomeDocument' );
+like_string $result,
+ qr!<h1 id="somedocument"><a name="$link"></a>Some Document</h1>!,
'0 heads should become chapter titles';
-like_string $result, qr!<h2 id="aheading">A Heading</h2>!,
+$link = encode_link( 'AHeading' );
+like_string $result, qr!<h2 id="aheading"><a name="$link"></a>A Heading</h2>!,
'A heads should become section titles';
-like_string $result, qr!<h3 id="bheading">B heading</h3>!,
+$link = encode_link( 'Bheading' );
+like_string $result, qr!<h3 id="bheading"><a name="$link"></a>B heading</h3>!,
'B heads should become subsection titles';
-like_string $result, qr!<h4 id="cheading">c heading</h4>!,
+$link = encode_link( 'cheading' );
+like_string $result, qr!<h4 id="cheading"><a name="$link"></a>c heading</h4>!,
'C heads should become subsubsection titles';
like_string $result, qr!<h1 id="another.+">Another Suppressed Heading</h1>!,
'... chapter title TOC suppression should create heading';
-like_string $result, qr/<a name="AnotherSuppressedHeading">/,
- '... but with anchor';
+$link = encode_link( 'AnotherSuppressedHeading' );
+unlike_string $result, qr/<a name="$link">/,
+ '... without anchor';
like_string $result, qr!<h2 id="asuppressed.+">A Suppressed Heading</h2>!,
'... section title suppression should create heading';
-like_string $result, qr/<a name="ASuppressedHeading">/,
- '... but with anchor';
+$link = encode_link( 'ASuppressedHeading' );
+unlike_string $result, qr/<a name="$link">/,
+ '... without anchor';
like_string $result, qr!<h3 id="yet.+ing">Yet Another Suppressed Heading</h3>!,
'... subsection title suppression should create heading';
-like_string $result, qr/<a name="YetAnotherSuppressedHeading">/,
- '... but with anchor';
+$link = encode_link( 'YetAnotherSuppressedHeading' );
+unlike_string $result, qr/<a name="$link">/,
+ '... without anchor';
like_string $result,
qr/<pre><code>\s*&quot;This text.+--.+ \$text.&quot;\n/s,
View
2  t/html/sidebar.t
@@ -5,7 +5,7 @@ use Test::More;
use Test::LongString;
use lib 't/lib';
-use TestDOM 'Pod::PseudoPod::DOM::Role::XHTML';
+use TestDOM 'Pod::PseudoPod::DOM::Role::HTML';
use File::Slurp;
use File::Spec::Functions;
View
2  t/html/tables.t
@@ -5,7 +5,7 @@ use Test::More;
use Test::LongString;
use lib 't/lib';
-use TestDOM 'Pod::PseudoPod::DOM::Role::XHTML';
+use TestDOM 'Pod::PseudoPod::DOM::Role::HTML';
use File::Spec::Functions;
use File::Slurp;
View
26 t/html/tags.t
@@ -5,7 +5,7 @@ use Test::More;
use Test::LongString;
use lib 't/lib';
-use TestDOM 'Pod::PseudoPod::DOM::Role::XHTML';
+use TestDOM 'Pod::PseudoPod::DOM::Role::HTML';
use File::Spec::Functions;
use File::Slurp;
@@ -14,28 +14,38 @@ use_ok( 'Pod::PseudoPod::DOM' ) or exit;
my $file = read_file( catfile( qw( t test_file.pod ) ) );
my $result = parse_with_anchors( $file );
-like_string $result, qr!<a name="startofdocument"></a>!m,
+my $link = encode_link( 'startofdocument' );
+like_string $result, qr!<a name="$link"></a>!m,
'Z<> tags should become anchors';
-like_string $result, qr!<a name="next_heading"></a>!m,
+$link = encode_link( 'next_heading' );
+like_string $result, qr!<a name="$link"></a>!m,
'... without normal escaping';
-like_string $result, qr!<a name="slightlycomplex\?heading"></a>!,
+$link = encode_link( 'slightlycomplex?heading' );
+like_string $result, qr!<a name="$link"></a>!,
'... and escaping non-alphanumerics';
like_string $result, qr!<a class="url" href="http://www.google.com/">!,
'U<> tag should become urls';
-like_string $result, qr!<a href="tags.t.pod#startofdocument">!,
+$link = encode_link( 'startofdocument' );
+like_string $result, qr!<a href="tags.t.pod#$link">!,
'L<> tag should become cross references';
-like_string $result, qr!<a href="tags.t.pod#startofdocument">!,
+like_string $result, qr!<a href="tags.t.pod#$link">!,
'A<> tag should become cross references';
-like_string $result, qr!<a href="tags.t.pod#slightlycomplex\?heading">!,
+$link = encode_link( 'slightlycomplex?heading' );
+like_string $result, qr!<a href="tags.t.pod#$link">!,
'... with appropriate quoting';
-like_string $result, qr!<a href="tags.t.pod#next_heading">!,
+$link = encode_link( 'next_heading' );
+like_string $result, qr!<a href="tags.t.pod#$link">!,
'... and non-quoting when appropriate';
+$link = encode_link( 'Specialformatting' );
+like_string $result, qr!<p><a name="${link}1"></a>Special formatting!,
+ '... paragraphs of index/anchor tags should collapse';
+
done_testing;
View
15 t/html/toc.t
@@ -4,7 +4,7 @@ use warnings;
use Test::More;
use lib 't/lib';
-use TestDOM 'Pod::PseudoPod::DOM::Role::XHTML';
+use TestDOM 'Pod::PseudoPod::DOM::Role::HTML';
use File::Spec::Functions;
use File::Slurp;
@@ -14,20 +14,25 @@ my $file = read_file( catfile( qw( t test_file.pod ) ) );
my ($doc, $result) = parse_with_anchors( $file, filename => 'html_toc.html' );
my $toc = $doc->emit_toc;
+my $link = encode_link( 'SomeDocument' );
+
like $toc, qr/Some Document/, 'TOC should contain chapter heading';
-like $toc, qr!<a href="html_toc.html#SomeDocument">Some Document</a>!,
+like $toc, qr!<a href="html_toc.html#toc_$link">Some Document</a>!,
'... with link to chapter heading anchor';
+$link = encode_link( 'AHeading' );
like $toc, qr/A Heading/, 'TOC should contain section heading';
-like $toc, qr!<a href="html_toc.html#AHeading">A Heading</a>!,
+like $toc, qr!<a href="html_toc.html#toc_$link">A Heading</a>!,
'... with link to section heading anchor';
+$link = encode_link( 'Bheading' );
like $toc, qr/B heading/, 'TOC should contain sub-section heading';
-like $toc, qr!<a href="html_toc.html#Bheading">B heading</a>!,
+like $toc, qr!<a href="html_toc.html#toc_$link">B heading</a>!,
'... with link to sub-section heading anchor';
+$link = encode_link( 'cheading' );
like $toc, qr/c heading/, 'TOC should contain sub-sub-section heading';
-like $toc, qr!<a href="html_toc.html#cheading">c heading</a>!,
+like $toc, qr!<a href="html_toc.html#toc_$link">c heading</a>!,
'... with link to sub-sub-section heading anchor';
unlike $toc, qr/Another Suppressed Heading/,
View
7 t/html/translations.t
@@ -5,7 +5,7 @@ use lib 't/lib';
use Test::More;
use Test::LongString;
-use TestDOM 'Pod::PseudoPod::DOM::Role::XHTML';
+use TestDOM 'Pod::PseudoPod::DOM::Role::HTML';
use File::Slurp;
use File::Spec::Functions;
@@ -66,10 +66,11 @@ like_string $result, qr!<em>semantic-only emphasis</em>!,
like_string $result, qr|<span class="footnote">but beware of footnotes!</span>|,
'footnotes need special escaping too';
-like_string $result, qr!^<a name="Specialformatting1"></a><p>!m,
+my $link = encode_link( 'Specialformatting' );
+like_string $result, qr!<p><a name="${link}1"></a>!m,
'indexed items need even more special escaping';
-like_string $result, qr!<a name="Specialformatting2"></a>!m,
+like_string $result, qr!<a name="${link}2"></a>!m,
'... and de-duplication';
like_string $result, qr!mc<sup>2</sup>!, 'superscript works';
View
8 t/lib/TestDOM.pm
@@ -5,6 +5,7 @@ use warnings;
use Pod::PseudoPod::DOM;
use Pod::PseudoPod::DOM::App;
+use MIME::Base64;
sub import
{
@@ -35,10 +36,11 @@ sub import
do
{
+ my $package = $caller[0] . '::';
no strict 'refs';
- *{ $caller[0] . '::' . 'parse' } = $parse;
- *{ $caller[0] . '::' . 'parse_with_anchors' } = $parse_with_anchors;
-
+ *{ $package . 'parse' } = $parse;
+ *{ $package . 'parse_with_anchors' } = $parse_with_anchors;
+ *{ $package . 'encode_link' } = \&MIME::Base64::encode_base64url;
};
}

No commit comments for this range

Something went wrong with that request. Please try again.