App-Chorus

 view release on metacpan or  search on metacpan

lib/App/Chorus/Slidedeck.pm  view on Meta::CPAN

    lazy => 1,
    default => sub {
        my $self = shift;
        
        my $markdown = $self->groom_markdown( $self->src_markdown );

        my $prez = markdown( $markdown );

        my $q = Web::Query->new_from_html( "<body>$prez</body>" );

    # move stuff in sections
    my $qs = Web::Query->new_from_html( "<div class='slides'></div>" );
    my $section;

    $q->contents->each(sub{
            my( $i, $elem ) = @_;

            if ( $elem->get(0)->tag =~ /^h[123456]$/ ) {
                $qs->append( "<section />" );
            }

            $elem->detach;
            $qs->find('section')->last->append($elem);
    });

    my $prev_section;
    $qs->find('section')->each(sub{
        my( $i, $elem ) = @_;

        my $head = $elem->find('h1,h2')->first or return;

        my $text = $head->text;

        if ( $text =~ s/cont'd//i ) {
            if ( $prev_section->find('section')->size == 0 ) {
                my $s = wq("<section />");
                for ( $prev_section->contents ) {
                    $_->detach;
                    $s->append($_);
                }
                $prev_section->append($s);
            }
                
            $head->text($text);
            $elem->detach;
            $prev_section->append($elem);
        }
        else {
            $prev_section = $elem;
        }

    });

    $qs->find('p')->each(sub{
            my(undef,$elem)=@_;

            if ( $elem->text =~ /^\s*\.{3}/ ) {
                (my $text = $elem->text ) =~ s/^\s*\.{3}//;
                $elem->text($text);
                if ( $elem->parent->get(0)->tag eq 'li' ) {
                    $elem->parent->add_class('fragment');
                }
                else {
                    $elem->add_class('fragment');
                }
            }

    });

    my $last_aside;
    $qs->find('aside')->each(sub{
        my $elem = $_;
        
        if ( $last_aside and $last_aside->parent->html eq $elem->parent->html ) {
            $elem->tagname('p');
            $last_aside->append( $elem );
            $elem->detach;
            return;
        }

        $last_aside = $elem;
    });

    # titles with a leading '^' want to be in the previous section
    $qs->find('h1,h2,h3')->each(sub{
        my $title = $_->html;

        return unless $title =~ s/^\s*\^//;
        $_->html($title);

        my $parent = $_->parent;
        my $prev = $parent->prev;

        unless( $prev->attr('nested') ) {
            my $new = wq( '<section nested="1" />' );
            $new->append($prev);
            $prev->replace_with($new);
            $prev = $new;
        }

        $parent->prev->append($parent);
        $parent->detach;

    });

    # titles that are lonely '---' are removed
    
    $qs->find('h1,h2,h3')->each(sub{
        return unless $_->html =~ /^\s*-+\s*$/;
        $_->html('');
    });

    $qs->find('section')->first->each(sub{
            $_->attr( 'class', $_->attr('class') . ' title_slide' );
    });

    return $qs->as_html;
    },

);

sub groom_markdown {
    my( $self, $md ) = @_;



( run in 3.413 seconds using v1.01-cache-2.11-cpan-b16cb0d3907 )