use HTML::Parser;
use URI;

sub replace_with_absolute_uri {
    # Parameter:
    #       $source:                HTML als Zeichenkette
    #       $current_uri:   $current_uri: absoluter URI als Ziel
    # Returns
    #       geändertes HTML als String

    my $source      = shift;
    my $current_uri = shift;

    # Puffer für geänderte Elemente
    my @replaced_data = ();
    # Variablen für Handler der Start-/Endelemente des HTML
    my ( $mystart, $myend );

    # Handler HTML-Startelemente
    $mystart = sub {
        my ( $tag, $attr, $self ) = @_;

        # HTML-Element <PRE>unverändert ausgeben
        if ( lc $tag eq "pre" ) {
            $self->handler(
                start => sub { my $s = shift; push @replaced_data, $s; },
                'text'
            );
            $self->handler( end => $myend, "tagname,self" );
        }

        # HTML-Element <CODE>, Code-Blocks unverändert ausgeben
        if ( lc $tag eq "code" ) {
            $self->handler(
                start => sub { my $s = shift; push @replaced_data, $s; },
                'text'
            );
            $self->handler( end => $myend, "tagname,self" );
        }

        # HTML-Element <A>, ein Link
        if ( lc $tag eq "a" ) {
            $self->handler( end => $myend, "tagname,self" );

            # URLs in RFC-gültige absolute URI umwandeln
            local $URI::ABS_REMOTE_LEADING_DOTS = 1;
            $attr->{ href } = URI->new( $attr->{ href } )->abs( $current_uri )
              if exists $attr->{ href };
        }

        local $URI::ABS_REMOTE_LEADING_DOTS = 1;
        # auch Attribut src, falls esistent! bei anderen HTML-Elemente auf absolute URI ändern
        $attr->{ src } = URI->new( $attr->{ src } )->abs( $current_uri )
          if exists $attr->{ src };

        # andere HTML Elemente wieder ausgeben (samt Attributen!)
        push @replaced_data, "<$tag";
        # zum HTML-Element Attribute und Werte ausgeben
        while ( my ( $att, $val ) = each %{ $attr } ) {
            push @replaced_data, qq/ $att="$val"/;
        }
        push @replaced_data, ">";
    };    ## end sub start

    # Handler HTML-Endelemente
    $myend = sub {
        my ( $tag, $self ) = @_;

        # HTML-Endelement ausgeben
        push @replaced_data, "</$tag>";
    };

    # HTML-Parser erzeugen
    my $p = HTML::Parser->new();
    $p->empty_element_tags( 1 );
    $p->xml_pic( 1 );    # damit auch z.B. <?php .... ?> geparst wird

    # Handlerroutine für bestimmte Startelemente registrieren
    $p->handler( start => $mystart, "tagname,attr,self" );
    # Handlerroutine für bestimmte Endelemente registrieren
    $p->handler( end => $myend, "tagname,self" );
    # Handlerroutine für normalen Textinhalt registrieren
    $p->handler(
        text => sub { my $s = shift; push @replaced_data, $s; },
        "text"
    );
    # Handlerroutine für Kommentare        registrieren
    $p->handler(
        comment => sub { my $s = shift; push @replaced_data, $s; },
        "text"
    );
    # Handlerroutine für PHP und anderes mit <? ?>
    $p->handler(
        process => sub { my $s = shift; push @replaced_data, $s; },
        "text"
    );

    # HTML nun parsen und ändern
    $p->parse( $source );

    return join "", @replaced_data;
} ## end sub replace_with_absolute_uri