Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

init

  • Loading branch information...
commit bd963d93cf4fdf118411809bbd692328bbd0ee36 0 parents
@wchristian authored
1  .gitignore
@@ -0,0 +1 @@
+cover_db
411 Pod/PseudoPod/DOM.pm
@@ -0,0 +1,411 @@
+package Pod::PseudoPod::DOM;
+# ABSTRACT: an object model for Pod::PseudoPod documents
+
+use strict;
+use warnings;
+
+use parent 'Pod::PseudoPod';
+
+use Class::Load;
+use Pod::PseudoPod::DOM::Elements;
+
+sub new
+{
+ my ($class, %args) = @_;
+ my $role = delete $args{formatter_role};
+ my $self = $class->SUPER::new(@_);
+ $self->{class_registry} = {};
+ $self->{formatter_role} = $role;
+ $self->{formatter_args} = $args{formatter_args} || {};
+ $self->{filename} = $args{filename};
+
+ Class::Load::load_class( $role );
+ $self->accept_targets( $role->accept_targets );
+ $self->accept_targets_as_text(
+ qw( author blockquote comment caution
+ editor epigraph example figure important listing literal note
+ production programlisting screen sidebar table tip warning )
+ );
+
+ $self->nbsp_for_S(1);
+ $self->codes_in_verbatim(1);
+
+ return $self;
+}
+
+sub parse_string_document
+{
+ my ($self, $document, %args) = @_;
+
+ if (my $environments = delete $args{emit_environments})
+ {
+ $self->accept_targets( keys %{ $environments } );
+ $self->{formatter_args}{emit_environments} = $environments;
+ }
+
+ return $self->SUPER::parse_string_document( $document );
+}
+
+sub _treat_Es
+{
+ my $self = shift;
+ my $formatter = $self->{formatter_role};
+ return if $formatter->can( 'encode_E_contents' );
+ return $self->SUPER::_treat_Es( @_ );
+}
+
+sub get_document
+{
+ my $self = shift;
+ return $self->{Document};
+}
+
+sub make
+{
+ my ($self, $type, @args) = @_;
+ my $registry = $self->{class_registry};
+ my $class = $registry->{$type};
+
+ unless ($class)
+ {
+ my $name = 'Pod::PseudoPod::DOM::Element::' . $type;
+ $class = $registry->{$type}
+ = $name->with_traits( $self->{formatter_role} );
+ }
+
+ return $class->new( %{ $self->{formatter_args} }, @args );
+}
+
+sub start_Document
+{
+ my $self = shift;
+
+ $self->{active_elements} =
+ [
+ $self->{Document} = $self->make( Document => type => 'document',
+ filename => $self->{filename} )
+ ];
+}
+
+sub end_Document
+{
+ my $self = shift;
+ $self->{active_elements} = [];
+}
+
+sub start_Verbatim
+{
+ my $self = shift;
+ $self->push_element( 'Paragraph', type => 'verbatim' );
+}
+
+sub end_Verbatim
+{
+ my $self = shift;
+ $self->reset_to_item( 'Paragraph', type => 'verbatim' );
+}
+
+sub reset_to_document
+{
+ my $self = shift;
+ $self->{active_elements} = [ $self->{Document} ];
+}
+
+sub push_element
+{
+ my $self = shift;
+ my $child = $self->make( @_ );
+
+ $self->{active_elements}[-1]->add_children( $child );
+ push @{ $self->{active_elements } }, $child;
+}
+
+sub add_element
+{
+ my $self = shift;
+ my $child = $self->make( @_ );
+ $self->{active_elements}[-1]->add( $child );
+}
+
+sub start_new_element
+{
+ my $self = shift;
+ push @{ $self->{active_elements} }, $self->make( @_ );
+}
+
+sub reset_to_item
+{
+ my ($self, $type, %attributes) = @_;
+ my $elements = $self->{active_elements};
+ my $class = 'Pod::PseudoPod::DOM::Element::' . $type;
+
+ while (@$elements)
+ {
+ my $element = pop @$elements;
+ next unless $element->isa( $class );
+
+ # reset iterator
+ my $attrs = keys %attributes;
+
+ while (my ($attribute, $value) = each %attributes)
+ {
+ $attrs-- if $element->$attribute() eq $value;
+ }
+
+ return $element unless $attrs;
+ }
+}
+
+BEGIN
+{
+ for my $heading ( 0 .. 4 )
+ {
+ my $start_meth = sub
+ {
+ my $self = shift;
+ $self->push_element(
+ Heading => level => $heading, type => 'header'
+ );
+ };
+
+ my $end_meth = sub
+ {
+ my $self = shift;
+ $self->reset_to_item( Heading => level => $heading );
+ };
+
+ do
+ {
+ no strict 'refs';
+ *{ 'start_head' . $heading } = $start_meth;
+ *{ 'end_head' . $heading } = $end_meth;
+ };
+ }
+
+ my %text_types =
+ (
+ Z => 'Anchor',
+ I => 'Italics',
+ C => 'Code',
+ N => 'Footnote',
+ U => 'URL',
+ A => 'Link',
+ G => 'Superscript',
+ H => 'Subscript',
+ B => 'Bold',
+ R => 'Italics',
+ F => 'File',
+ E => 'Character',
+ X => 'Index',
+ L => 'Link',
+ );
+
+ while (my ($tag, $type) = each %text_types)
+ {
+ my $start_meth = sub
+ {
+ my $self = shift;
+ $self->push_element( 'Text::' . $type, type => lc $type );
+ };
+
+ my $end_meth = sub
+ {
+ my $self = shift;
+ $self->reset_to_item( 'Text::' . $type, type => lc $type );
+ };
+
+ do
+ {
+ no strict 'refs';
+ *{ 'start_' . $tag } = $start_meth;
+ *{ 'end_' . $tag } = $end_meth;
+ };
+ }
+
+ for my $list_type (qw( bullet text block number ))
+ {
+ my $start_list_meth = sub
+ {
+ my $self = shift;
+ $self->push_element( 'List', type => $list_type . '_list' );
+ };
+
+ my $end_list_meth = sub
+ {
+ my $self = shift;
+ my $list = $self->reset_to_item( 'List',
+ type => $list_type . '_list'
+ );
+ $list->fixup_list if $list;
+ };
+
+ my $start_item_meth = sub
+ {
+ my ($self, $args) = @_;
+ my @marker = $args->{number}
+ ? (marker => $args->{number})
+ : ();
+
+ $self->push_element( 'ListItem',
+ type => $list_type . '_item', @marker
+ );
+ };
+
+ my $end_item_meth = sub
+ {
+ my $self = shift;
+ $self->reset_to_item( 'ListItem', type => $list_type . '_item' );
+ };
+
+ do
+ {
+ no strict 'refs';
+ *{ 'start_over_' . $list_type } = $start_list_meth;
+ *{ 'end_over_' . $list_type } = $end_list_meth;
+ *{ 'start_item_' . $list_type } = $start_item_meth;
+ *{ 'end_item_' . $list_type } = $end_item_meth;
+ };
+ }
+}
+
+sub handle_text
+{
+ my $self = shift;
+ $self->add_element( 'Text::Plain' => type => 'plaintext', content => $_[0]);
+}
+
+sub start_Para
+{
+ my $self = shift;
+ $self->push_element( Paragraph => type => 'paragraph' );
+}
+
+sub end_Para
+{
+ my $self = shift;
+ $self->reset_to_item( Paragraph => type => 'paragraph' );
+}
+
+sub start_for
+{
+ my ($self, $flags) = @_;
+ do { $flags->{$_} = '' unless defined $flags->{$_} } for qw( title target );
+
+ $self->push_element( Block =>
+ type => 'block',
+ title => $flags->{title},
+ target => $flags->{target} );
+}
+
+sub end_for
+{
+ my $self = shift;
+ $self->reset_to_item( 'Block' );
+}
+
+sub start_sidebar
+{
+ my ($self, $flags) = @_;
+ $self->push_element( Block => type => 'sidebar', title => $flags->{title} );
+}
+
+sub end_sidebar
+{
+ my $self = shift;
+ $self->reset_to_item( 'Block' );
+}
+
+sub start_table
+{
+ my ($self, $flags) = @_;
+ $self->push_element( Table => 'type' => 'table', title => $flags->{title} );
+}
+
+sub end_table
+{
+ my $self = shift;
+ my $table = $self->reset_to_item( 'Table' );
+
+ $self->fix_title( $table ) if $table->title;
+ $table->fixup;
+}
+
+sub fix_title
+{
+ my ($self, $element) = @_;
+ my $title = $element->title;
+ my $title_elem = $self->start_new_element(
+ Paragraph => type => 'paragraph' );
+ my $tag_regex = qr/([IC]<+\s*.+?\s*>+)/;
+ my @parts;
+
+ for my $part (split /$tag_regex/, $title)
+ {
+ if ($part =~ /$tag_regex/)
+ {
+ my ($type, $content) = $part =~ /^([IC])<+\s*(.+?)\s*>+/;
+ my $start = "start_$type";
+ my $end = "end_$type";
+ $self->$start;
+ $self->handle_text( $content );
+ $self->$end;
+ }
+ else
+ {
+ $self->handle_text( $part );
+ }
+ }
+
+ $element->title( $self->end_Para );
+}
+
+sub start_headrow
+{
+ my $self = shift;
+ $self->push_element( TableRow => 'type' => 'headrow' );
+}
+
+sub end_headrow
+{
+ my $self = shift;
+ $self->reset_to_item( 'TableRow' );
+}
+
+sub start_row
+{
+ my $self = shift;
+ $self->push_element( TableRow => 'type' => 'row' );
+}
+
+sub end_row
+{
+ my $self = shift;
+ $self->reset_to_item( 'TableRow' );
+}
+
+sub start_cell
+{
+ my $self = shift;
+ $self->push_element( TableCell => 'type' => 'cell' );
+}
+
+sub end_cell
+{
+ my $self = shift;
+ $self->reset_to_item( 'TableCell' );
+}
+
+sub start_figure
+{
+ my ($self, $flags) = @_;
+ $self->push_element( Figure => type => 'figure',
+ caption => $flags->{title} );
+}
+
+sub end_figure
+{
+ my $self = shift;
+ $self->reset_to_item( 'Figure' )->fixup_figure;
+}
+
+1;
310 Pod/PseudoPod/DOM/Elements.pm
@@ -0,0 +1,310 @@
+package Pod::PseudoPod::DOM::Elements;
+# ABSTRACT: the base classes for PseudoPod DOM objects
+
+use strict;
+use warnings;
+
+use Moose;
+
+{
+ package Pod::PseudoPod::DOM::Element;
+
+ use Moose;
+ with 'MooseX::Traits';
+
+ has 'type', is => 'ro', required => 1;
+ sub is_empty { 1 }
+}
+
+{
+ package Pod::PseudoPod::DOM::ParentElement;
+
+ use Moose;
+
+ extends 'Pod::PseudoPod::DOM::Element';
+
+ has 'children',
+ is => 'rw',
+ isa => 'ArrayRef[Pod::PseudoPod::DOM::Element]',
+ default => sub { [] };
+
+ sub add
+ {
+ my $self = shift;
+ push @{ $self->children }, grep { defined } @_;
+ }
+
+ sub add_children { push @{ shift->children }, @_ }
+
+ sub is_empty { return @{ shift->children } == 0 }
+}
+
+{
+ package Pod::PseudoPod::DOM::Element::Paragraph;
+
+ use Moose;
+
+ extends 'Pod::PseudoPod::DOM::ParentElement';
+}
+
+{
+ package Pod::PseudoPod::DOM::Element::Text::Plain;
+
+ use Moose;
+
+ extends 'Pod::PseudoPod::DOM::ParentElement';
+ has 'content', is => 'rw';
+
+ sub add
+ {
+ my $self = shift;
+ $self->content( shift );
+ }
+
+ sub is_empty { length( shift->content ) == 0 }
+}
+
+{
+ my $parent = 'Pod::PseudoPod::DOM::Element::Text';
+
+ for my $text_item (qw(
+ Anchor Bold Character Code Entity File Footnote Italics Index Link
+ Subscript Superscript URL ))
+ {
+ Class::MOP::Class->create(
+ $parent . '::' . $text_item =>
+ superclasses => [ 'Pod::PseudoPod::DOM::ParentElement' ]
+ );
+ }
+}
+
+{
+ package Pod::PseudoPod::DOM::Element::Heading;
+
+ use Moose;
+
+ extends 'Pod::PseudoPod::DOM::ParentElement';
+
+ has 'level', is => 'ro', required => 1;
+}
+
+{
+ package Pod::PseudoPod::DOM::Element::List;
+
+ use Moose;
+
+ extends 'Pod::PseudoPod::DOM::ParentElement';
+
+ sub fixup_list
+ {
+ my $self = shift;
+ my $kids = $self->children;
+ my @newkids;
+ my $prev;
+
+ for my $i (0 .. $#$kids)
+ {
+ my $kid = $kids->[$i];
+ if ($kid->isa( 'Pod::PseudoPod::DOM::Element::ListItem' ))
+ {
+ push @newkids, $prev if $prev;
+ $prev = $kid;
+ next;
+ }
+ next if $kid->is_empty;
+
+ $prev->add( $kid );
+ }
+ push @newkids, $prev if $prev;
+
+ $self->children( \@newkids );
+ }
+}
+
+{
+ package Pod::PseudoPod::DOM::Element::ListItem;
+
+ use Moose;
+ has 'marker', is => 'ro';
+
+ extends 'Pod::PseudoPod::DOM::ParentElement';
+}
+
+{
+ package Pod::PseudoPod::DOM::Element::Sidebar;
+
+ use Moose;
+
+ extends 'Pod::PseudoPod::DOM::ParentElement';
+
+ has 'title', is => 'rw', default => '';
+}
+
+{
+ package Pod::PseudoPod::DOM::Element::Figure;
+
+ use Moose;
+
+ extends 'Pod::PseudoPod::DOM::ParentElement';
+
+ has 'caption', is => 'rw', default => '';
+ sub fixup_figure
+ {
+ my $self = shift;
+ my $children = $self->children;
+ @$children = map
+ {
+ $_->type eq 'paragraph'
+ ? @{ $_->children }
+ : $_
+ } @$children;
+ }
+
+ sub anchor
+ {
+ my $self = shift;
+ for my $kid (@{ $self->children })
+ {
+ next unless $kid->type eq 'anchor';
+ return $kid;
+ }
+ }
+
+ sub file
+ {
+ my $self = shift;
+ for my $kid (@{ $self->children })
+ {
+ next unless $kid->type eq 'file';
+ return $kid;
+ }
+ }
+}
+
+{
+ package Pod::PseudoPod::DOM::Element::Block;
+
+ use Moose;
+
+ has 'title', is => 'ro', default => '';
+ has 'target', is => 'ro', default => '';
+
+ extends 'Pod::PseudoPod::DOM::ParentElement';
+}
+
+{
+ package Pod::PseudoPod::DOM::Element::Table;
+
+ use Moose;
+ use List::Util 'first';
+
+ has 'title', is => 'rw', default => '';
+
+ extends 'Pod::PseudoPod::DOM::ParentElement';
+
+ # make sure all kids are rows
+ sub fixup
+ {
+ my $self = shift;
+ my $children = $self->children;
+ my $kidclass = 'Pod::PseudoPod::DOM::Element::TableRow';
+ my $prev = first { $_->isa( $kidclass ) } @$children;
+
+ for my $kid (@$children)
+ {
+ if ($kid->isa( $kidclass ))
+ {
+ $prev = $kid;
+ }
+ else
+ {
+ $prev->add( $kid );
+ }
+ }
+
+ @$children = grep { $_->isa( $kidclass ) } @$children;
+
+ $_->fixup for @$children;
+ }
+
+ sub num_cols
+ {
+ my $self = shift;
+ return $self->headrow->num_cells;
+ }
+
+ sub headrow
+ {
+ my $self = shift;
+ my $rows = $self->children;
+
+ return unless @$rows;
+ return $rows->[0];
+ }
+
+ sub bodyrows
+ {
+ my $self = shift;
+ my $rows = $self->children;
+
+ return unless @$rows and @$rows > 1;
+ return @{ $rows }[1 .. $#$rows ];
+ }
+}
+
+{
+ package Pod::PseudoPod::DOM::Element::TableRow;
+
+ use Moose;
+ use List::Util 'first';
+
+ extends 'Pod::PseudoPod::DOM::ParentElement';
+
+ # if adding non-cell to row, add to previous cell
+
+ sub cells { shift->children }
+ sub num_cells { 0 + @{ shift->children } }
+
+ # make sure all kids are cells
+ sub fixup
+ {
+ my $self = shift;
+ my $children = $self->children;
+ my $kidclass = 'Pod::PseudoPod::DOM::Element::TableCell';
+ my $prev = first { $_->isa( $kidclass ) } @$children;
+
+ for my $kid (@$children)
+ {
+ if ($kid->isa( $kidclass ))
+ {
+ $prev = $kid;
+ }
+ else
+ {
+ $prev->add( $kid );
+ }
+ }
+
+ @$children = grep { $_->isa( $kidclass ) } @$children;
+ }
+}
+
+{
+ package Pod::PseudoPod::DOM::Element::TableCell;
+
+ use Moose;
+
+ extends 'Pod::PseudoPod::DOM::ParentElement';
+}
+
+{
+ package Pod::PseudoPod::DOM::Element::Document;
+
+ use Moose;
+
+ has 'externals', is => 'ro', default => sub { {} };
+
+ extends 'Pod::PseudoPod::DOM::ParentElement';
+}
+
+1;
523 Pod/PseudoPod/DOM/Role/LaTeX.pm
@@ -0,0 +1,523 @@
+package Pod::PseudoPod::DOM::Role::LaTeX;
+# ABSTRACT: an LaTeX formatter role for PseudoPod DOM trees
+
+use strict;
+use warnings;
+
+use Moose::Role;
+
+requires 'type';
+has 'tables', is => 'rw', default => sub { {} };
+has 'filename', is => 'ro', default => '';
+has 'emit_environments', is => 'ro', default => sub { {} };
+
+sub accept_targets { 'latex' }
+
+sub add_table
+{
+ my ($self, $table) = @_;
+ my $filename = $self->filename;
+ my $tables = $self->tables;
+ my $count = keys %$tables;
+ (my $id = $filename)
+ =~ s/\.(\w+)$/'_table' . $count . '.tex'/e;
+
+ $tables->{$id} = $table;
+ return $id;
+}
+
+sub emit
+{
+ my $self = shift;
+ my $type = $self->type;
+ my $emit = 'emit_' . $type;
+
+ $self->$emit( @_ );
+}
+
+sub emit_document
+{
+ my $self = shift;
+ return $self->emit_kids( document => $self );
+}
+
+sub emit_kids
+{
+ my $self = shift;
+ join '', map { $_->emit( @_ ) } @{ $self->children }
+}
+
+sub emit_header
+{
+ my $self = shift;
+ my $level = $self->level;
+ my $text = $self->emit_kids;
+ my $suppress = $text =~ s/^\*// ? '*' : '';
+
+ return qq|\\chapter${suppress}{$text}\n\n| if $level == 0;
+
+ my $subs = 'sub' x ($level - 1);
+ return qq|\\${subs}section${suppress}{$text}\n\n|;
+}
+
+sub emit_plaintext
+{
+ my ($self, %args) = @_;
+ my $content = defined $self->content ? $self->content : '';
+
+ if (my $encode = $args{encode})
+ {
+ my $method = 'encode_' . $encode;
+ return $self->$method( $content, %args );
+ }
+
+ return $self->encode_text( $content, %args );
+}
+
+sub encode_none { return $_[1] }
+
+sub encode_split
+{
+ my ($self, $content, %args) = @_;
+ my $target = $args{target};
+ return join $args{joiner},
+ map { $self->encode_text( $_ ) } split /\Q$target\E/, $content;
+}
+
+sub encode_index_text
+{
+ my ($self, $text) = @_;
+
+ my @terms;
+
+ for my $term (split /;/, $text)
+ {
+ $term =~ s/^\s+|\s+$//g;
+ $term =~ s/"/""/g;
+ $term =~ s/([!|@])/"$1/g;
+ $term =~ s/([#\$&%_{}])/\\$1/g;
+ push @terms, $term;
+ }
+
+ return join '!', @terms;
+}
+
+sub encode_label_text
+{
+ my ($self, $text) = @_;
+ $text =~ s/[^\w:]/-/g;
+
+ return $text;
+}
+
+sub encode_verbatim_text
+{
+ my ($self, $text) = @_;
+
+ $text =~ s/([{}])/\\$1/g;
+ $text =~ s/\\(?![{}])/\\textbackslash{}/g;
+ $text =~ s/([#\$&%_])/\\$1/g;
+
+ return $text;
+}
+
+sub encode_text
+{
+ my ($self, $text) = @_;
+
+ # Escape LaTeX-specific characters
+ $text =~ s/\\/\\backslash/g; # backslashes are special
+ $text =~ s/([#\$&%_{}])/\\$1/g;
+ $text =~ s/(\^)/\\char94{}/g; # carets are special
+ $text =~ s/</\\textless{}/g;
+ $text =~ s/>/\\textgreater{}/g;
+
+ $text =~ s/(\\backslash)/\$$1\$/g; # add unescaped dollars
+
+ # use the right beginning quotes
+ $text =~ s/(^|\s)"/$1``/g;
+
+ # and the right ending quotes
+ $text =~ s/"(\W|$)/''$1/g;
+
+ # fix the ellipses
+ $text =~ s/\.{3}\s*/\\ldots /g;
+
+ # fix the ligatures
+ $text =~ s/f([fil])/f\\mbox{}$1/g unless $self->{keep_ligatures};
+
+ # fix emdashes
+ $text =~ s/\s--\s/---/g;
+
+ # fix tildes
+ $text =~ s/~/\$\\sim\$/g;
+
+ # suggest hyphenation points for module names
+ $text =~ s/::/::\\-/g;
+
+ return $text;
+}
+
+sub emit_literal
+{
+ my $self = shift;
+
+ if (my $title = $self->title)
+ {
+ return join "\n\n",
+ map
+ {
+ $_->emit_kids(
+ encode => 'split', target => $title, joiner => "\\\\\n"
+ )
+ } @{ $self->children };
+ }
+
+ return qq||
+ . join( "\\\\\n", map { $_->emit_kids( @_ ) } @{ $self->children } )
+ . qq|\n|;
+}
+
+sub emit_anchor
+{
+ my $self = shift;
+ return '\\label{' . $self->emit_kids( encode => 'label_text' ) . qq|}\n\n|;
+}
+
+sub emit_italics
+{
+ my $self = shift;
+ return '\\emph{' . $self->emit_kids( @_ ) . '}';
+}
+
+sub emit_number_item
+{
+ my $self = shift;
+ my $marker = $self->marker;
+ my $number = $marker ? qq| number="$marker"| : '';
+ return "\\item " . $self->emit_kids( @_ ) . "\n\n";
+}
+
+sub emit_text_item
+{
+ my $self = shift;
+ my $kids = $self->children;
+ return qq|\\item[]\n| unless @$kids;
+
+ my $first = (shift @$kids)->emit;
+ my $prelude = $first =~ /\D/
+ ? q|\\item[] | . $first
+ : qq|\\item[$first]|;
+
+ return $prelude . "\n\n" . join( '', map { $_->emit } @$kids );
+}
+
+sub emit_bullet_item
+{
+ my $self = shift;
+ my $kids = $self->children;
+ return qq|\\item\n| unless @$kids;
+
+ return q|\\item | . join( '', map { $_->emit } @$kids ) . qq|\n\n|;
+}
+
+sub emit_code
+{
+ my $self = shift;
+ return '\\texttt{' . $self->emit_kids( @_ ) . '}';
+}
+
+sub emit_footnote
+{
+ my $self = shift;
+ return '\\footnote{' . $self->emit_kids( @_ ) . '}';
+}
+
+sub emit_url
+{
+ my $self = shift;
+ return q|\\url{| . $self->emit_kids( encode => 'verbatim_text' ) . '}';
+}
+
+sub emit_link
+{
+ my $self = shift;
+ return qq|\\ppodxref{| . $self->emit_kids( encode => 'label_text' ). q|}|;
+}
+
+sub emit_superscript
+{
+ my $self = shift;
+ return '$^{' . $self->emit_kids( @_ ) . '}$';
+}
+
+sub emit_subscript
+{
+ my $self = shift;
+ return '$_{' . $self->emit_kids( @_ ) . '}$';
+}
+
+sub emit_bold
+{
+ my $self = shift;
+ return '\\textbf{' . $self->emit_kids( @_ ) . '}';
+}
+
+sub emit_file
+{
+ my $self = shift;
+ return '\\emph{' . $self->emit_kids( @_ ) . '}';
+}
+
+sub emit_paragraph
+{
+ my $self = shift;
+ my $has_visible_text = grep { $_->type ne 'index' } @{ $self->children };
+ return $self->emit_kids( @_ ) . ( $has_visible_text ? "\n\n" : '' );
+}
+
+use constant { BEFORE => 0, AFTER => 1 };
+my $escapes = "commandchars=\\\\\\{\\}";
+
+my %parent_items =
+(
+ text_list => [ qq|\\begin{description}\n\n|,
+ qq|\\end{description}| ],
+ bullet_list => [ qq|\\begin{itemize}\n\n|,
+ qq|\\end{itemize}| ],
+ number_list => [ qq|\\begin{enumerate}\n\n|,
+ qq|\\end{enumerate}| ],
+ map { $_ => [ qq|\\begin{$_}\n|, qq|\\end{$_}\n\n| ] }
+ qw( epigraph blockquote )
+);
+
+while (my ($tag, $values) = each %parent_items)
+{
+ my $sub = sub
+ {
+ my $self = shift;
+ return $values->[BEFORE]
+ . $self->emit_kids( @_ )
+ . $values->[AFTER] . "\n\n";
+ };
+
+ do { no strict 'refs'; *{ 'emit_' . $tag } = $sub };
+}
+
+sub emit_programlisting
+{
+ my $self = shift;
+
+ # should be only a single Verbatim; may need to fix with hoisting
+ my $kid = $self->children->[0];
+
+ return qq|\\begin{CodeListing}\n|
+ . $kid->emit_kids( encode => 'verbatim_text' )
+ . qq|\n\\end{CodeListing}\n|;
+}
+
+sub emit_verbatim
+{
+ my $self = shift;
+ return qq|\\begin{Verbatim}[$escapes]\n|
+ . $self->emit_kids( encode => 'verbatim_text' )
+ . qq|\n\\end{Verbatim}\n|;
+}
+
+sub emit_screen
+{
+ my $self = shift;
+ # should be only a single Verbatim; may need to fix with hoisting
+ my $kid = $self->children->[0];
+
+ return qq|\\begin{Verbatim}[$escapes,label=Program output]\n|
+ . $kid->emit_kids( encode => 'verbatim_text' )
+ . qq|\n\\end{Verbatim}\n|;
+}
+
+my %characters = (
+ acute => sub { qq|\\'| . shift },
+ grave => sub { qq|\\`| . shift },
+ uml => sub { qq|\\"| . shift },
+ cedilla => sub { '\c' }, # ccedilla
+ opy => sub { '\copyright' }, # copy
+ dash => sub { '---' }, # mdash
+ lusmn => sub { '\pm' }, # plusmn
+ mp => sub { '\&' }, # amp
+);
+
+sub emit_character
+{
+ my $self = shift;
+
+ my $content = eval { $self->emit_kids( @_ ) };
+ return unless defined $content;
+
+ if (my ($char, $class) = $content =~ /(\w)(\w+)/)
+ {
+ return $characters{$class}->($char) if exists $characters{$class};
+ }
+
+ return Pod::Escapes::e2char( $content );
+}
+
+sub emit_index
+{
+ my $self = shift;
+ return '\\index{'
+ . $self->emit_kids( encode => 'index_text' )
+ . '}';
+}
+
+sub emit_latex
+{
+ my $self = shift;
+ return $self->emit_kids( encode => 'none' ) . "\n";
+}
+
+sub emit_block
+{
+ my $self = shift;
+ my $title = $self->title;
+ my $target = $self->target;
+
+ if (my $environment = $self->emit_environments->{$target})
+ {
+ $target = $environment;
+ }
+ elsif (my $meth = $self->can( 'emit_' . $target))
+ {
+ return $self->$meth( @_ );
+ }
+
+ return $self->make_basic_block( $self->target, $self->title, @_ );
+}
+
+sub make_basic_block
+{
+ my ($self, $target, $title, @rest) = @_;
+
+ $title = defined $title ? qq|[$title]| : '';
+
+ return qq|\\begin{$target}$title\{\n|
+ . $self->emit_kids( @rest )
+ . qq|}\\end{$target}\n|;
+}
+
+sub encode_E_contents {}
+
+sub emit_sidebar
+{
+ my $self = shift;
+ my $title = $self->title;
+ my $env = $self->emit_environments;
+
+ return $self->make_basic_block( $env->{sidebar}, $title, @_ )
+ if exists $env->{sidebar};
+
+ if ($title)
+ {
+ $title = <<END_TITLE;
+\\begin{center}
+\\large{\\bfseries{$title}}
+\\end{center}
+END_TITLE
+ }
+ else
+ {
+ $title = '';
+ }
+
+ return <<END_HEADER . $self->emit_kids( @_ ) . <<END_FOOTER;
+\\begin{figure}[H]
+\\begin{center}
+\\begin{Sbox}
+\\begin{minipage}{\\linewidth}
+$title
+END_HEADER
+\\end{minipage}
+\\end{Sbox}
+\\framebox{\\TheSbox}
+\\end{center}
+\\end{figure}
+END_FOOTER
+
+}
+
+sub emit_table
+{
+ my ($self, %args) = @_;
+ my $title = $self->title->emit_kids( encode => 'text' );
+ my $num_cols = $self->num_cols;
+ my $width = 1.0 / $num_cols;
+ my $cols = join ' | ', map { 'X' } 1 .. $num_cols;
+
+ my $document = $args{document};
+ my $caption = length $title
+ ? "\\caption{" . $title . "}\n"
+ : '';
+
+ my $start = "\\begin{longtable}{| $cols |}\n";
+ my $end = "$caption\\end{longtable}\n";
+ my $id = $document->add_table( $start . $self->emit_kids( @_ ) . $end );
+
+ return <<TABLE_REFERENCE;
+\\begin{center}
+\\LTXtable{\\linewidth}{$id}
+\\end{center}
+TABLE_REFERENCE
+}
+
+sub emit_headrow
+{
+ my $self = shift;
+ my $row = $self->emit_row;
+ $row =~ s{(\\hline\n)$}{\\endhead$1}s;
+ return "\\hline\n\\rowcolor[gray]{.9}\n$row";
+}
+
+sub emit_row
+{
+ my $self = shift;
+ my $contents = join ' & ', map { $_->emit } @{ $self->children };
+ return $contents . "\\\\\\hline\n";
+}
+
+sub emit_cell
+{
+ my $self = shift;
+ my @contents;
+
+ for my $child (@{ $self->children })
+ {
+ my $contents = $child->emit( @_ );
+ $contents =~ s/\n+$//g;
+ next unless $contents =~ /\S/;
+ push @contents, $contents;
+ }
+
+ return join '\\newline\\newline ', @contents;
+}
+
+sub emit_figure
+{
+ my $self = shift;
+ my $caption = $self->caption;
+ $caption = defined $caption
+ ? '\\caption{' . $self->encode_text( $caption ) . "}\n"
+ : '';
+
+ my $anchor = $self->anchor;
+ $anchor = defined $anchor ? $anchor->emit : '';
+
+ my $file = $self->file->emit_kids( encode => 'none' );
+
+ return <<END_FIGURE;
+\\begin{figure}[H]
+\\centering
+\\includegraphics[width=\\linewidth]{$file}
+$caption$anchor\\end{figure}
+END_FIGURE
+}
+
+1;
28 TestDOM.pm
@@ -0,0 +1,28 @@
+package TestDOM;
+
+use Pod::PseudoPod::DOM;
+
+sub import
+{
+ my ($self, $formatter, @args) = @_;
+
+ my @caller = caller;
+ my $filename = $caller[1] . '.tex';
+ my $sub = sub
+ {
+ my $document = shift;
+ my $parser = Pod::PseudoPod::DOM->new(
+ formatter_role => $formatter,
+ filename => $filename,
+ @_
+ );
+ $parser->parse_string_document( $document, @_ );
+ my $doc = $parser->get_document;
+ my $text = $doc->emit;
+ return wantarray ? ($doc, $text) : $text;
+ };
+
+ do { no strict 'refs'; *{ $caller[0] . '::' . 'parse' } = $sub };
+}
+
+1;
17 coverthis.pl
@@ -0,0 +1,17 @@
+#!perl
+
+use strict;
+use warnings;
+
+=pod
+ Plack/Session
+ Plack/Request.pm
+ Sub/Quote.pm
+=cut
+
+my @select = qw(
+);
+
+system( "cover -delete" );
+system( "perl -MDevel::Cover" . ( @select ? "=-select," . join( ",", @select ) : "" ) . " tags.t" );
+system( "cover" );
10 tags.t
@@ -0,0 +1,10 @@
+use strict;
+use warnings;
+
+use TestDOM 'Pod::PseudoPod::DOM::Role::LaTeX';
+use File::Slurp;
+use Pod::PseudoPod::DOM;
+
+my $file = read_file( "test_file.pod" );
+my $result = parse( $file );
+exit;
263 test_file.pod
@@ -0,0 +1,263 @@
+=head0 Some Document
+
+Z<startofdocument>
+
+Here is some ignorable text.
+
+=head1 A Heading
+
+Z<next_heading>
+
+This is part of some document (L<startofdocument>; A<startofdocument>).
+
+=begin programlisting
+
+ "This text should not be escaped -- it is normal $text."
+
+ #!/bin/perl does need escaping, as do \ (backslashes)
+
+=end programlisting
+
+ This indented text should come through unmodified too -- it is also "normal"
+ $text.
+
+=begin screen
+
+ This should also be $unm0d+ified
+
+=end screen
+
+=begin blockquote
+
+Blockquoted text may or may not need "escaped". I haven't decided.
+
+=end blockquote
+
+=head2 B heading
+
+Z<slightly complex?heading>
+
+Encode the noble octothorpe, #, and the slash used for escaping: \. There are
+lots of other escapable characters, including $ & % and _. The curly braces,
+{}, get escaped too. The tilde, ~, has something special too.
+
+"The interesting thing is that when you use double quotes," he said, "they turn
+into double single quotes going in the correct direction."
+
+The caret ^ is interesting too.
+
+(A<slightly complex?heading> links to this section! L<next_heading> links to
+the previous.)
+
+=head3 c heading
+
+When you leave out words, add an ellipsis... and get out an escaped version.
+
+Words like flame, filk, and ineffable have interesting ligatures -- and you
+need a bit of work to make the typography work out nicely.
+
+Diacritics are more difficult E<aacute> la the naE<iuml>ve attachE<egrave> and
+the E<copy> caper, E<plusmn> some constant. FranE<ccedilla>aise has some fun
+ones.
+
+=for sidebar
+
+Hello, this is a sidebar
+
+=end
+
+X<Special formatting>
+
+Special formatting is B<very> important, especially in C<code-like text>, for
+special F<emphasis>, and I<semantic-only emphasis>N<but beware of footnotes!>.
+Try to format correctly Google URL: U<< http://www.google.com/ >>. A false
+value such as C<0> or I<0> should work even in inline markup.
+
+Index entries are more fun, as more special characters must be escaped, with
+a quote sign. E.g. X<negation ! operator>, X<array @ sigil>, X<the pipe |>
+and X<strange quote a"a>.
+
+More, we should be able to have superscripts like I<E = mcG<2>> or
+subscripts, like I<HH<2>O>.
+
+=for latex
+
+ Sometimes it would be good to send direct commands to \LaTeX
+ Indentation should not be verbatim. Nothing should be touched.
+
+=end
+
+Hierarchical terms are also possible, separating single terms with a semicolon.
+Spaces around comma (e.g. in X< hierarchical terms ; omitting trailing spaces>)
+should be ignored, as they influence sorting order.
+
+
+Lists are fun:
+
+=over 4
+
+=item Verbatim
+
+=item List
+
+=item items
+
+=back
+
+Bulleted lists rule too:
+
+=over 4
+
+=item * BANG
+
+=item * $BANG BANG$
+
+And they might have more lines. And they _ are $ properly % escaped.
+
+=item * BANGERANG!
+
+=back
+
+Definition lists are useful:
+
+=over 4
+
+=item wakawaka
+
+What Pac-Man says.
+
+=item has_method
+
+And add_method are escaped
+
+=item ook ook
+
+What the librarian says.
+
+=back
+
+Numeric lists are more fun:
+
+=over 4
+
+=item 2
+
+First
+
+=item 33
+
+Second
+
+=item 77
+
+Fooled you!
+
+=back
+
+And of course, normal numbered lists:
+
+=over 4
+
+=item 1
+
+Something.
+
+=item 2
+
+Or.
+
+=item 3
+
+Other.
+
+=back
+
+=begin foo Title
+
+Something
+
+=end foo
+
+Now here is a table.
+
+=begin table A Table of I<Fun> Things
+
+=headrow
+
+=cell I<Left Column>
+
+=cell I<Right Column>
+
+=bodyrows
+
+=row
+
+=cell Left Cell One
+
+=cell
+
+=over 4
+
+=item * First item in right column
+
+=item * Second item in right column
+
+=item * Third item in right column
+
+=back
+
+=row
+
+=cell Left Cell Two
+
+=cell Right Cell Two
+
+=end table
+
+Basic bulleted list:
+
+=over 4
+
+=item * First item
+
+=item * Second item
+
+=item * Third item
+
+=back
+
+=begin figure A Figure with Caption
+
+Z<figure_link>
+
+F<some/path/to/image_file.png>
+
+=end figure
+
+=head0 *Another Suppressed Heading
+
+=head1 *A Suppressed Heading
+
+=head2 *Yet Another Suppressed Heading
+
+=begin literal \\
+
+Here are several paragraphs.\\
+They should have I<newlines> in between them.\\\\
+... and that is all.
+
+=end literal
+
+=begin tip Design Principle
+
+This is a design principle.
+
+It has multiple parts.
+
+=end tip
+
+=for latex
+
+\pagebreak
+
+=end for
Please sign in to comment.
Something went wrong with that request. Please try again.