File Coverage

blib/lib/Bible/OBML.pm

Criterion	Covered	Total	%
statement	223	223	100.0
branch	52	58	89.6
condition	21	26	80.7
subroutine	21	21	100.0
pod	3	3	100.0
total	320	331	96.6

package Bible::OBML;
# ABSTRACT: Open Bible Markup Language parser and renderer

use 5.022;

use exact;
use exact::class;
use Mojo::DOM;
use Mojo::Util 'html_unescape';
use Text::Wrap 'wrap';
use Bible::Reference;

$Text::Wrap::unexpand = 0;

our $VERSION = '2.11'; # VERSION

has _load             => sub { {} };
has indent_width      => 4;
has reference_acronym => 0;
has fnxref_acronym    => 1;
has wrap_at           => 80;
has reference         => sub {
    Bible::Reference->new(
        bible                 => 'Protestant',
        sorting               => 1,
        require_chapter_match => 1,
        require_book_ucfirst  => 1,
    );
};

sub __ocd_tree ($node) {
    my $new_node;

    if ( 'tag' eq shift @$node ) {
        $new_node->{tag} = shift @$node;

        my $attr = shift @$node;
        $new_node->{attr} = $attr if (%$attr);

        shift @$node;

        my $children = [ grep { defined } map { __ocd_tree($_) } @$node ];
        $new_node->{children} = $children if (@$children);
    }
    else {
        $new_node->{text} = $node->[0] if ( $node->[0] ne "\n\n" );
    }

    return $new_node;
}

sub __html_tree ($node) {
    if ( $node->{tag} ) {
        if ( $node->{children} ) {
            my $attr = ( $node->{attr} )
                ? ' ' . join( ' ', map { $_ . '="' . $node->{attr}{$_} . '"' } keys %{ $node->{attr} } )
                : '';

            return join( '',
                '<', $node->{tag}, $attr, '>',
                (
                    ( $node->{children} )
                        ? ( map { __html_tree($_) } @{ $node->{children} } )
                        : ()
                ),
                '{tag}, '>',
            );
        }
        else {
            return '<' . $node->{tag} . '>';
        }
    }
    else {
        return $node->{text};
    }
}

sub __cleanup_html ($html) {
    # spacing cleanup
    $html =~ s/\s+/ /g;
    $html =~ s/(?:^\s+|\s+$)//mg;
    $html =~ s/^[ ]+//mg;

    # protect against inadvertent OBML
    $html =~ s/~/-/g;
    $html =~ s/`/'/g;
    $html =~ s/\|//g;
    $html =~ s/\\/ /g;
    $html =~ s/\*//g;
    $html =~ s/\{/(/g;
    $html =~ s/\}/)/g;
    $html =~ s/\[/(/g;
    $html =~ s/\]/)/g;

    $html =~ s||\n\n|g;
    $html =~ s||\n\n|g;
    $html =~ s||\n\n|g;
    $html =~ s|\s*|\n|g;
    $html =~ s|[ ]+||g;
    $html =~ s|[ ]+||;

    # trim spaces at line ends
    $html =~ s/[ ]+$//mg;

    return $html;
}

sub __clean_html_to_data ($clean_html) {
    return __ocd_tree( Mojo::DOM->new($clean_html)->at('obml')->tree );
}

sub __data_to_clean_html ($data) {
    return __cleanup_html( __html_tree($data) );
}

sub _clean_html_to_obml ( $self, $html ) {
    my $dom = Mojo::DOM->new($html);

    # append a trailing  inside any  with a  for later wrapping reasons
    $dom->find('p')->grep( sub { $_->find('br')->size } )->each( sub { $_->append_content('') } );

    my $obml = html_unescape( $dom->to_string );

    # de-XML
    $obml =~ s|||g;
    $obml =~ s|| |g;
    $obml =~ s|||g;
    $obml =~ s||\*|g;
    $obml =~ s||\^|g;
    $obml =~ s||\\|g;
    $obml =~ s|\s*|~ |g;
    $obml =~ s|\s*| ~|g;
    $obml =~ s!\s*!|!g;
    $obml =~ s!\s*!| !g;
    $obml =~ s|\s*|== |g;
    $obml =~ s|\s*| ==|g;
    $obml =~ s|\s*|= |g;
    $obml =~ s|\s*| =|g;
    $obml =~ s|\s*|\{|g;
    $obml =~ s|\s*|\}|g;
    $obml =~ s|\s*|\[|g;
    $obml =~ s|\s*|\]|g;
    $obml =~ s|^| ' ' x ( $self->indent_width * $1 ) |mge;
    $obml =~ s|||g;
    $obml =~ s|||g;

    if ( $self->wrap_at ) {
        # wrap lines that don't end in
        $obml = join( "\n", map {
            unless ( s||| ) {
                s/^(\s+)//;
                my $header = $1 || '';
                $Text::Wrap::columns = $self->wrap_at - length($header);
                wrap( $header, $header, $_ );
            }
            else {
                $_;
            }
        } split( /\n/, $obml ) ) . "\n";
    }
    $obml =~ s|||g;
    $obml =~ s|[ ]+$||mg;
    $obml =~ s/\n{3,}/\n\n/g;
    $obml =~ s/^[ ]([^ ])/$1/mg;

    chomp $obml;
    return $obml;
}

sub _obml_to_clean_html ( $self, $obml ) {
    # spacing cleanup
    $obml =~ s/\r?\n/\n/g;
    $obml =~ s/\t/    /g;
    $obml =~ s/\n[ \t]+\n/\n\n/mg;
    $obml =~ s/^\n+//g;
    $obml =~ /^(\s+)/;
    $obml =~ s/^$1//mg if ($1);
    $obml =~ s/\s+$//g;

    # remove comments
    $obml =~ s/^\s*#.*?(?>\r?\n)//msg;

    # "unwrap" wrapped lines
    my @obml;
    for my $line ( split( /\n/, $obml ) ) {
        if ( not @obml or not length $line or not length $obml[-1] ) {
            push( @obml, $line );
        }
        else {
            my ($last_line_indent) = $obml[-1] =~ /^([ ]*)/;
            my ($this_line_indent) = $line     =~ /^([ ]*)/;

            if ( length $last_line_indent == 0 and length $this_line_indent == 0 ) {
                $line =~ s/^[ ]+//;
                $obml[-1] .= ' ' . $line;
            }
            else {
                push( @obml, $line );
            }
        }
    }
    $obml = join( "\n", @obml );

    $obml =~ s|~+[ ]*([^~]+?)[ ]*~+|$1|g;
    $obml =~ s|={2,}[ ]*([^=]+?)[ ]*={2,}|$1|g;
    $obml =~ s|=[ ]*([^=]+?)[ ]*=|$1|g;

    $obml =~ s|^([ ]+)(\S.*)$|
        '
210
        . int( ( length($1) + $self->indent_width * 0.5 ) / $self->indent_width )
        . '">'
        . $2
        . ''
    |mge;

    $obml =~ s|(\S)(?=\n\S)|$1|g;

    $obml =~ s`(?:^|(?<=\n\n))(?!<(?:reference|sub_header|header)\b)``g;
    $obml =~ s`(?:$|(?=\n\n))``g;
    $obml =~ s`(?<=)``g;
    $obml =~ s`(?<=)``g;
    $obml =~ s`(?<=)``g;

    $obml =~ s!\|(\d+)\|\s*!$1!g;

    $obml =~ s|\*([^\*]+)\*|$1|g;
    $obml =~ s|\^([^\^]+)\^|$1|g;
    $obml =~ s|\\([^\\]+)\\|$1|g;

    $obml =~ s|\{||g;
    $obml =~ s|\}||g;

    $obml =~ s|\[||g;
    $obml =~ s|\]||g;

    return "$obml";
}

sub _accessor ( $self, $input = undef ) {
    my $want = ( split( '::', ( caller(1) )[3] ) )[-1];

    if ($input) {
        if ( ref $input ) {
            my $data_refs_ocd;
            $data_refs_ocd = sub ($node) {
                if (
                    $node->{tag} and $node->{children} and
                    ( $node->{tag} eq 'crossref' or $node->{tag} eq 'footnote' )
                ) {
                    for ( grep { $_->{text} } @{ $node->{children} } ) {
                        $_->{text} = $self->reference->acronyms(
                            $self->fnxref_acronym
                        )->clear->in( $_->{text} )->as_text;
                    }
                }
                if ( $node->{children} ) {
                    $data_refs_ocd->($_) for ( @{ $node->{children} } );
                }
                return;
            };
            $data_refs_ocd->($input);

            my $reference = ( grep { $_->{tag} eq 'reference' } @{ $input->{children} } )[0]{children}[0];
            my $runs      = $self->reference->acronyms(
                $self->reference_acronym
            )->clear->in( $reference->{text} )->as_runs;

            $reference->{text} = $runs->[0];
        }
        else {
            my $ref_ocd = sub ( $text, $acronyms ) {
                return $self->reference->acronyms($acronyms)->clear->in($text)->as_text;
            };

            $input =~ s!
                ((?:<(?:footnote|crossref)>|\{|\[)\s*.+?\s*(?:|\}|\]))
            !
                $ref_ocd->( $1, $self->fnxref_acronym )
            !gex;

            $input =~ s!
                ((?:|~)\s*.+?\s*(?:|~))
            !
                $ref_ocd->( $1, $self->reference_acronym )
            !gex;
        }

        return $self->_load({ $want => $input });
    }

    return $self->_load->{data} if ( $want eq 'data' and $self->_load->{data} );

    unless ( $self->_load->{canonical}{$want} ) {
        if ( $self->_load->{html} ) {
            $self->_load->{clean_html} //= __cleanup_html( $self->_load->{html} );

            if ( $want eq 'obml' ) {
                $self->_load->{canonical}{obml} = $self->_clean_html_to_obml( $self->_load->{clean_html} );
            }
            elsif ( $want eq 'data' or $want eq 'html' ) {
                $self->_load->{data} = __clean_html_to_data( $self->_load->{clean_html} );

                $self->_load->{canonical}{html} = __data_to_clean_html( $self->_load->{data} )
                    if ( $want eq 'html' );
            }
        }
        elsif ( $self->_load->{data} ) {
            $self->_load->{canonical}{html} = __data_to_clean_html( $self->_load->{data} );

            $self->_load->{canonical}{obml} = $self->_clean_html_to_obml( $self->_load->{canonical}{html} )
                if ( $want eq 'obml' );
        }
        elsif ( $self->_load->{obml} ) {
            $self->_load->{canonical}{html} = $self->_obml_to_clean_html( $self->_load->{obml} );

            if ( $want eq 'obml' ) {
                $self->_load->{canonical}{obml} = $self->_clean_html_to_obml(
                    $self->_load->{canonical}{html}
                );
            }
            elsif ( $want eq 'data' ) {
                $self->_load->{data} = __clean_html_to_data( $self->_load->{canonical}{html} );
            }
        }
    }

    return ( $want eq 'data' ) ? $self->_load->{$want} : $self->_load->{canonical}{$want};
}

sub data { shift->_accessor(@_) }
sub html { shift->_accessor(@_) }
sub obml { shift->_accessor(@_) }

1;

__END__