package toc;

use strict;
use warnings;
use 5.020;
use HTML::Parser;

use vars qw( $toc );

sub toc {
    my $source = shift;

    my @parsed  = ();
	
    my $tag_sub = sub {
        my $s = shift;
	my $tag = shift;
        if ( $tag =~ m/[hH](\d)/ ) {
		push @parsed, "level $1: $s";
	}
    };
    my $text_sub = sub { 
	push @parsed, shift; 
    };

    # HTML-Parser erzeugen
    my $p = HTML::Parser->new(
        api_version   => 3,
        start_h       => [ $tag_sub,  "text,tagname" ],
        end_h         => [ $tag_sub,  "text,tagname" ],
        #process_h     => [ $text_sub, "text" ],
        #comment_h     => [ $text_sub, "text" ],
        #declaration_h => [ $text_sub, "text" ],
        #default_h     => [ $text_sub, "text" ],
    );
    $p->empty_element_tags(1);
    $p->report_tags( qw(h1 h2 h3 h4 h5 h6) );
    $p->xml_pic(1);    
    $p->utf8_mode(1);
    $p->case_sensitive(1); 
    $p->parse($source);
    $p->eof();
    
    return "\n\n<!--\n" . join("\n",@parsed) . "\n-->\n\n";
}

sub story {
    my ( $story_ref ) = @_;

    $toc = toc::toc($$story_ref);	
	$$story_ref =~ s/\Q{{{%%TOC%%}}}\E/Inhalt:\n$toc/;

    return 1;
}

1;

package main;

#use toc;

my $DATA = join "",<DATA>;

toc::story(\$DATA);

say $toc::toc;

__DATA__

{{{%%TOC%%}}}

<h1>Test 1</H1>

<p>Test</p>

<h2>Test 2</H2>

<p>Test 123</p>

<h2>Test 3</H2>

<p>Test</p>

<h1>Test 4</H1>

<p>Test</p>

<h1>Test 5</H1>

<p>Test</p>