package Pod::SAX::HyperScope; use strict; use warnings; use base 'XML::SAX::Base'; use HTML::Entities qw(encode_entities); our $VERSION = '0.01'; our $SECTION_RX = qr/^(head\d+|para|(itemized|ordered)list|listitem)$/; our $INLINE_RX = qr/^(I|B|C|F|X|Z|link)$/; our $XSL_URI_DEFAULT = "/hyperscope/src/client/lib/hs/xslt/hyperscope.xsl"; sub new { my ( $class, %args ) = @_; my $self = $class->SUPER::new(%args); $self->{hs} = $self->{hs_top} = $self->_new_level( text => "POD" ); $self->{xsl_uri} = $args{xsl_uri} || $XSL_URI_DEFAULT; $self->{indent} = $args{indent} || 3; $self->{head_cache}->[0] = $self->{hs_top}; $self->{ignore_markup} = 0; return $self; } sub start_document { my $self = shift; } sub end_document { my $self = shift; ${ $self->{output} } = $self->_create_opml(); } sub start_element { my ( $self, $ele ) = @_; if ( $ele->{LocalName} =~ /^head(\d+)$/ ) { my $level = $1; $self->{hs} = $self->{head_cache}->[$level - 1]; $self->{head_cache}->[$level] = $self->_indent(); splice @{ $self->{head_cache} }, $level + 1; } elsif ( $ele->{LocalName} eq 'verbatim' ) { $self->_indent(); $self->{hs}->{text} .= '
';
}
elsif ( $ele->{LocalName} =~ $SECTION_RX ) {
$self->_indent();
}
elsif ( $ele->{LocalName} =~ $INLINE_RX ) {
$self->{hs}->{text} .= $self->_inline_tag_map( $ele->{LocalName} );
}
elsif ( $ele->{LocalName} eq 'xlink' ) {
my $href = $ele->{Attributes}->{'{}href'}->{Value} || "";
$self->{hs}->{text} .= "";
}
elsif ( $ele->{LocalName} eq 'markup' ) {
if ( $ele->{Attributes}->{'{}ordinary_paragraph'}->{Value} ) {
$self->_indent( text => $ele->{Attributes}->{'{}type'}->{Value} );
}
else {
$self->{ignore_markup} = 1;
}
}
}
sub end_element {
my ( $self, $ele ) = @_;
if ( $ele->{LocalName} =~ /^head(\d+)$/ ) {
return;
}
elsif ( $ele->{LocalName} =~ $SECTION_RX ) {
$self->_outdent();
}
elsif ( $ele->{LocalName} eq 'verbatim' ) {
$self->_outdent();
$self->{hs}->{text} .= '';
}
elsif ( $ele->{LocalName} =~ $INLINE_RX ) {
$self->{hs}->{text} .= $self->_inline_tag_map( $ele->{LocalName}, 1 );
}
elsif ( $ele->{LocalName} eq 'xlink' ) {
$self->{hs}->{text} .= "";
}
elsif ( $ele->{LocalName} eq 'markup' ) {
$self->_outdent unless $self->{ignore_markup};
$self->{ignore_markup} = 0;
}
}
sub characters {
my ( $self, $content ) = @_;
if ( defined $content->{Data} ) {
$self->{hs}->{text} .= encode_entities( $content->{Data} );
}
}
sub _inline_tag_map {
my ( $self, $pod_tag, $end ) = @_;
my $tag = {
B => 'b',
I => 'i',
C => 'tt',
F => 'tt',
'link' => 'tt',
}->{$pod_tag} || "";
return "" unless $tag;
return $end ? "$tag>" : "<$tag>";
}
sub _indent {
my ( $self, %args ) = @_;
my $nl = $self->_new_level( parent => $self->{hs}, %args );
push @{ $self->{hs}->{children} }, $nl;
$self->{hs} = $nl;
return $self->{hs};
}
sub _outdent {
my $self = shift;
$self->{hs} = $self->{hs}->{parent} if defined $self->{hs}->{parent};
}
sub _new_level {
my ( $self, %args ) = @_;
return {
parent => $args{parent},
text => $args{text},
children => $args{children} || [],
};
}
sub _create_opml {
my $self = shift;
my $xsl_uri = $self->{xsl_uri};
my $opml = <