view release on metacpan or  search on metacpan

lib/ChordPro/Output/HTML.pm  view on Meta::CPAN

}

sub html {
    my $t = shift;
    $t =~ s/&/&/g;
    $t =~ s/</&lt;/g;
    $t =~ s/>/&gt;/g;
    $t;
}

# Temporary. Eventually we'll have a decent HTML backend for Text::Layout.

package Text::Layout::HTML;

use parent 'Text::Layout';

use ChordPro::Utils qw(fq);

# Eliminate warning when HTML backend is loaded together with Text backend.
no warnings 'redefine';

sub new {
    my ( $pkg, @data ) = @_;
    my $self = $pkg->SUPER::new;
    $self->{_currentfont} = { family => 'default',
			      style => 'normal',
			      weight => 'normal' };
    $self->{_currentcolor} = 'black';
    $self->{_currentsize} = 12;
    $self;
}

*html = \&ChordPro::Output::HTML::html;

sub render {
    my ( $self ) = @_;
    my $res = "";
    foreach my $fragment ( @{ $self->{_content} } ) {
	if ( $fragment->{type} eq 'strut' ) {
	    next unless length($fragment->{label}//"");
	    $res .= "<span id=\"".$fragment->{label}."\"/>";
	    next;
	}
	next unless length($fragment->{text});
	my $f = $fragment->{font} || $self->{_currentfont};
	my @c;			# styles
	my @d;			# decorations
	if ( $f->{style} eq "italic" ) {
	    push( @c, q{font-style:italic} );
	}
	if ( $f->{weight} eq "bold" ) {
	    push( @c, q{font-weight:bold} );
	}
	if ( $fragment->{color} && $fragment->{color} ne $self->{_currentcolor} ) {
	    push( @c, join(":","color",$fragment->{color}) );
	}
	if ( $fragment->{size} && $fragment->{size} ne $self->{_currentsize} ) {
	    push( @c, join(":","font-size",$fragment->{size}) );
	}
	if ( $fragment->{bgcolor} ) {
	    push( @c, join(":","background-color",$fragment->{bgcolor}) );
	}
	if ( $fragment->{underline} ) {
	    push( @d, q{underline} );
	}
	if ( $fragment->{strikethrough} ) {
	    push( @d, q{line-through} );
	}
	push( @c, "text-decoration-line:@d" ) if @d;
	my $href = $fragment->{href} // "";
	$res .= "<a href=\"".html($href)."\">" if length($href);
	$res .= "<span$href style=\"" . join(";",@c) . "\">" if @c;
	$res .= html(fq($fragment->{text}));
	$res .= "</span>" if @c;
	$res .= "</a>" if length($href);
    }
    $res;
}

1;