##################################################
package Quark;
##################################################

use Pod::Parser;
use constant MAX_VERBATIM_LEN => 35;

our @ISA = qw(Pod::Parser);

##################################################
sub initialize {
##################################################
    my ($parser) = @_;

    $parser->{Intro} = 1;
}

##################################################
sub command {
##################################################
    my ($parser, $command, $para, $line) = @_;

    my $tag = "";
    my $quark = 0;
    
    $parser->{InVerbatim} = 0;

    return if $command eq 'pod';
    return if $command eq 'over';

    if ($command eq 'head1') {
        $tag = '@T:';
    } elsif ($command eq 'head2') {
        $tag = '@ZT:';
    } elsif ($command eq 'item') {
        $para =~ s/\s+$//s;
        $parser->{Item} = $para;
        return;
    } elsif ($command eq 'for') {
        return unless $para =~ /^quark/;
        $quark = 1;
        $para =~ s/^quark\s*\n//;
    }

    my $text = $parser->interpolate($para, $line);
    $text = quark_esc($text, '@\\') unless $quark;
    $parser->output("$tag$text");
}

##################################################
sub verbatim {
##################################################
    my($parser, $text) = @_;

    return if $text =~ /^\s*$/s;

        # Zeilenlänge prüfen
    while($text =~ /(.*)/g) {
        if(length($1) > MAX_VERBATIM_LEN) {
            warn "Verbatim line too long: $1";
        }
    }

    $text = quark_esc($text, '<@\\');
    $text =~ s/^ {4}//mg;
    
        # Absatz im Verbatim-Stück?
    if($parser->{InVerbatim}) {
        $parser->output("$text");
        return 1;
    }
    
    $parser->{InVerbatim} = 1;

    $parser->output("\@LI:\n$text");
}

##################################################
sub interior_sequence {
##################################################
    my ($parser, $cmd, $arg) = @_;

        # B<.>, I<.> und C<.> wird <I>.<I>
    if($cmd =~ /B|I|C/) {
        return "<I>$arg<I>";
    }
        # E<.> Notierung für Sonderzeichen in POD
    if($cmd eq "E") {
        $arg eq "gt" && return ">";
        $arg eq "lt" && return quark_esc('<','<');
    }
}

##################################################
sub textblock {
##################################################
    my ($parser, $para, $line) = @_;

    my $tag = "";

    if(exists $parser->{Item}) {
        $para = "$parser->{Item} $para";
        delete $parser->{Item};
    } else {
        $tag = '@L:';
    }

    my $text = $parser->interpolate($para, $line);
    $text = quark_esc($text, '@\\');


    if($parser->{Intro}) {
        $tag = "\@V:";
        $parser->{Intro}  = 0;
    }

    $parser->{InVerbatim} = 0;
    $parser->output("$tag$text");
}

##################################################
sub output { 
##################################################
    my($parser, $text) = @_;

    my $out_fh = $parser->output_handle;
    print $out_fh $text;
}

##################################################
sub quark_esc {
##################################################
    my ($string, $chars) = @_;

        # Backslash drin oder nicht?
    my $backslash = ($chars =~ s-\\--);

        # Alles ausser Backslashes ersetzen
    $string =~ s-([$chars])-<\\$1>-g;

    if($backslash) {
            # Sonderbehandlung
        $string =~ s-(?<!<)(\\)-<\\$1>-g;
    }
    
    return $string; 
}