File Coverage

blib/lib/Perl6/Pod/FormattingCode/L.pm

Criterion	Covered	Total	%
statement	18	46	39.1
branch	0	20	0.0
condition	0	26	0.0
subroutine	6	9	66.6
pod	0	3	0.0
total	24	104	23.0

package Perl6::Pod::FormattingCode::L;

=pod

=head1 NAME

Perl6::Pod::FormattingCode::L - handle "L" formatting code

=head1 SYNOPSIS

A standard web URL. For example:

    This module needs the LAME library
    (available from L)


=head1 DESCRIPTION

The L<> code is used to specify all kinds of links, filenames, citations, and cross-references (both internal and external).

A link specification consists of a scheme specifier terminated by a colon, followed by an external address (in the scheme's preferred syntax), followed by an internal address (again, in the scheme's syntax). All three components are optional, though at least one must be present in any link specification.

Usually, in schemes where an internal address makes sense, it will be separated from the preceding external address by a #, unless the particular addressing scheme requires some other syntax. When new addressing schemes are created specifically for Perldoc it is strongly recommended that # be used to mark the start of internal addresses.

=cut

use warnings;
use strict;
use Data::Dumper;
use Perl6::Pod::FormattingCode;
use base 'Perl6::Pod::FormattingCode';
use Perl6::Pod::Utl;
our $VERSION = '0.01';

sub new {
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    #parse conntent
    if (0) {
      my $txt = $self->{'content'};
      ( $self->{alt_text}, $txt ) =  split( /\s*\|\s*/, $txt ) if $txt =~/\|/;
      #cut scheme
      if ( $txt =~s/^\s*(\w+):// ) {
        $self->{scheme} = $1;
      }
      #is_external
      if ( $txt =~ s%^//%%) {
        $self->{is_external}='//'
      }
      #cut address
      if ($txt =~ /([^\#]*)(?:\#(.*))?/) {
            $self->{address} = $1 ||'';
            $self->{section} = $2 || '';
      }
    }
    return $self;
}

sub to_xhtml {
    my ( $self, $to ) = @_;
    my $w  = $to->w;
    my $scheme = $self->{scheme}|| '';
    if (  ( $scheme =~ /^https?|.*$/ ) or $self->{section} ) {
                my $url = $self->{address} || '';
                $url .= "#" . $self->{section} if $self->{section};
                $url = $self->{scheme} .  ($scheme =~ /^https?/ ? '//' : '') . $url if $self->{is_external} || ($self->{scheme} && $self->{scheme} eq 'mailto:');
                $w->raw('');
                unless  ( $self->{alt_text}) {
                            $w->print($url)
                } else {
                    $to->visit(Perl6::Pod::Utl::parse_para($self->{alt_text}))
                }
                $w->raw('');
      }
}

sub to_docbook {
    my ( $self, $to ) = @_;
    my $w  = $to->w;
    my $scheme = $self->{scheme}|| '';
    if (  ( $scheme =~ /^https?|.*$/ ) or $self->{section} ) {
                my $url = $self->{address} || '';
                $url .= "#" . $self->{section} if $self->{section};
                $url = $self->{scheme} .  ($scheme =~ /^https?/ ? '//' : '') . $url if $self->{is_external} || ($self->{scheme} && $self->{scheme} eq 'mailto:');
                $w->raw('');
                unless  ( $self->{alt_text}) {
                            $w->print($url)
                } else {
                    $to->visit(Perl6::Pod::Utl::parse_para($self->{alt_text}))
                }
                $w->raw('');
      }
}
1;
__END__