package BNC::Doc;

use strict;
use warnings;

use BNC::Meta;
use Encode;
use HTML::Entities;
use charnames ":full"; # full Unicode character names in strings and regexps

use CWB;

=head1 NAME

BNC::Doc - Read and convert BNC document to in-memory representation


=head1 SYNOPSIS;

  use BNC::Doc;

  $text = new BNC::Doc "Texts/A/AA/AAA.xml", "html";        # .xml.gz also supported
  ## optional second argument specifies encoding: 
  ##   utf8 (default), html (latin1 + HTML entities), mapped (latin1 approximation + Unicode names (e.g. for Greek))

  $att_val_hash = $text->text_cat;               # attribute-value hash (values are strings)
  $att_val_hash = $text->text_cat_numeric;       # (values are numeric codes)
  $value = $text->text_meta("title");            # free-form metadata and statistics (string value for given attribute)

  @speaker_ids = $text->speakers;                # list of speaker IDs for spoken texts
  foreach $id (@speaker_ids) {
    $att_val_hash = $text->speaker_cat($id);                # attribute-value hash (values are strings)
    $att_val_hash = $text->speaker_cat_numeric($id);        # (values are numeric codes)
    $value = $text->speaker_meta($id, "n_words");           # free-form metadata and statistics (string value for given attribute)
    $value = $text->speaker_meta($id, "name", "???");       # default value substituted for missing data
  }

  $lines = $text->body;                 # reference to array containing body data
  foreach $line (@$lines) {
    if (ref $line) {                    # arrayref = token line
      ($word, $pos, $hw_class, $hw, $class, $type, 
       $flags_before, $space_after, $tags_before, $tags_after, $offset) = @$line;
    }
    else {                              # plain string = XML tag
      $tag = $line;
    }
  }

=head1 DESCRIPTION


=head2 Methods

=over 4

=item $text = new BNC::Doc $filename [, $encoding];

Reads and converts BNC document from XML file I<$filename> (may be gzipped with extension I<.gz>).
The option argument I<$encoding> specifies the output encoding of the converted document.  Currently supported encodings:

=over 4

=item utf8

The default encoding is plain UTF-8 (as in the original BNC XML files), with unsafe XML characters replaced by entities (C<&lt;>, C<&gt;>, C<&amp;>, C<&quot;>).  This is in general the most elegant and reliable solution, but UTF-8 is not supported very well by current versions of the Corpus Workbench.

=item html

Mixed Latin-1/HTML encoding intended for B<BNCweb> and other Web interfaces.  The text is encoded in Latin-1 (ISO-8859-1), with non-latin and unsafe characters represented by HTML entities (named entities if available, numeric entities otherwise).  This encoding is a good compromise between CWB compatibility, ease of use and faithful representation of the original text.

=item mapped

Pure Latin-1 encoding for interactive use of the BNC in a B<cqp> terminal session.  Some frequent non-latin characters are mapped to ASCII approximations, including the following:

  ``       LEFT SINGLE QUOTATION MARK (rendered as double quote for readability)
  ''       RIGHT SINGLE QUOTATION MARK, DOUBLE PRIME
  ...      ELLIPSIS
  --       EN DASH
  ---      EM DASH
  OE, oe   LATIN CAPITAL / SMALL LIGATURE OE
  <-, ->   LEFTWARDS / RIGHTWARDS ARROW
  <=, >=   LESS-THAN / GREATER-THAN OR EQUAL TO
  ~, *     TILDE / ASTERISK OPERATOR
  {TM}     TRADE MARK SIGN
  {1/2}    VULGAR FRACTION ONE HALF
  {1/4}    VULGAR FRACTION ONE QUARTER
  {3/4}    VULGAR FRACTION THREE QUARTERS
  ...      other vulgar fractions that are not in Latin-1

All other non-latin characters are represented by their Unicode names in curly braces, e.g. C<{GREEK CAPITAL LETTER GAMMA}> (note that word forms and annotations may contain blanks in this encoding), and unsafe characters are represented by HTML entities.  This encoding is recommended only if you intend to use the BNC directly in B<cqp> and want the text display to be as readable as possible.

=back

=cut

sub new {
  my ($class, $filename, $encoding) = @_;
  $encoding = "utf8" unless $encoding;
  $encoding = lc($encoding);
  die "BNC::Doc: encoding '$encoding' not supported.\n"
    unless $encoding =~ /^(utf8|html|mapped)$/;
  my $self = bless({}, $class);
  $self->{FILENAME} = $filename;
  $self->{ENCODING} = $encoding;
  $self->{TEXT_CAT} = text_cat_table();
  $self->{TEXT_META} = {};
  $self->{SPKR_CAT} = {}; # will be initialised as $self->{SPKR_CAT}->{$id} = speaker_cat_table();
  $self->{SPKR_META} = {};
  $self->{BODY} = [];
  $self->{LINE_BUFFER} = []; # buffered input from XSLT script, allowing for lookahead
  $self->{PIPE} = undef;
  $self->{EOF} = -1; # -1 = pipe not open, 0 = not at EOF, 1 = at EOF (but may still have lines in buffer)

  $self->load($filename);
  return $self;
}

our $parseBncDoc = join("\n", <DATA>)."\n"; # load parseBncDoc.xsl from __DATA__ section
DATA->close;

our $space_after_yes = " ";     # standard values of space_after attribute (may be modified by encoding script)
our $space_after_no = "";
## $space_after_yes = "[ ]"; # for debugging
## $space_after_no = "[]";

our $tags_init = "";        # value of tags_before and tags_after if no tags are present (encoding script may add prefix to avoid empty values)

sub load {
  my ($self, $filename) = @_;
  my $encoding = $self->{ENCODING};
  die "BNC::Doc: file '$filename' does not exist.\n"
    unless -f $filename;
  die "BNC::Doc: file '$filename' must have extension .xml or .xml.gz\n"
    unless $filename =~ /\.xml(\.gz)?$/i;
  my $xslt_script = new CWB::TempFile "parseBncDoc.xsl"; # save XSLT script for parsing BNC documents to temporary file
  $xslt_script->write($parseBncDoc);
  $xslt_script->finish;
  my $xslt_path = $xslt_script->name; # file will be deleted automatically when $xslt_script goes out of scope
  my $pipe = CWB::OpenFile "xsltproc $xslt_path $filename |"
    or die "BNC::Doc: cannot run xsltproc: $!\n";
  binmode($pipe, ":utf8"); # read UTF-8 data from xsltproc
  $self->{PIPE} = $pipe;
  $self->{EOF} = 0;

  $_ = <$pipe>; # readline() method will only be used in text body
  die "BNC::Doc: error in xsltproc output for file $filename\n          expected '<?xml ...>' but got: $_"
    unless /^<\?xml/;
  $_ = <$pipe>;
  die "BNC::Doc: error in xsltproc output for file $filename\n          expected '<root>' but got: $_"
    unless /^<root/;

  my %spkr_id_map = ();         # some speaker names need to be transformed to ensure they are unique
  READ_HEADER:
  while (<$pipe>) {             # process header information
    chomp;
    my ($att, $val, @F) = split /\t/;
    last if $att eq "BODY";     # marks end of header
    $val =~ s/^\s+//;           # remove leading and trailing whitespace from attribute values
    $val =~ s/\s+$//;
    if ($att eq "ID" or $att eq "TITLE") {
      $self->{TEXT_META}->{lc($att)} = encode_string($val, $encoding);
    }
    elsif ($att eq "CATREF") {
      process_catrefs($self->{TEXT_CAT}, $val);
    }
    elsif ($att eq "DLEE") {
      $self->{TEXT_CAT}->{"DLee"} = find_code_or_die("DLee", $val);
    }
    elsif ($att eq "KEYWORD") {
      $self->{TEXT_META}->{"keywords"} = [] unless exists $self->{TEXT_META}->{"keywords"};
      push @{ $self->{TEXT_META}->{"keywords"} }, [$val, "@F"];
    }
    elsif ($att eq "TEXTTYPE") {
      $self->{TEXT_CAT}->{"derivedTextType"} = find_code_or_die("derivedTextType", $val);
    }
    elsif ($att eq "SIZE") {
      $val =~ /([0-9]+)\s*token/ or die "BNC::Doc: token count not found in size info '$val' (file $filename)\n";
      $self->{TEXT_META}->{"n_words"} = $1;
      $val =~ /([0-9]+)\s*w-unit/ or die "BNC::Doc: number of <w> units not found in size info '$val' (file $filename)\n";
      $self->{TEXT_META}->{"n_w"} = $1;
      $val =~ /([0-9]+)\s*s-unit/ or die "BNC::Doc: number of <s> units not found in size info '$val' (file $filename)\n";
      $self->{TEXT_META}->{"n_s"} = $1;
    }
    elsif ($att eq "SPEAKER") {
      my $id = $val;
      if ($id eq "PS001") {
        my $text_id = $self->{TEXT_META}->{"id"};
        if (not defined $text_id) {
          warn "BNC::Doc: Can't make speaker $id unique, since file ID hasn't been read yet!\n";
          $text_id = "";
        }
        $id = $spkr_id_map{$id} = $text_id.$id; # ensure that speaker IDs are unique (PS001 appears in three files)
      }
      else {
        $spkr_id_map{$id} = $id;
      }
      my ($ageGroup, $dialect, $firstLang, $educ, $soc, $sex, $role, $age, $name, $occupation) = @F;
      $self->{SPKR_CAT}->{$id} = speaker_cat_table();
      $self->{SPKR_CAT}->{$id}->{"ageGroup"}  = find_code_or_die("ageGroup", $ageGroup) if $ageGroup;
      $self->{SPKR_CAT}->{$id}->{"dialect"}   = find_code_or_die("dialect", $dialect) if $dialect;
      $self->{SPKR_CAT}->{$id}->{"firstLang"} = find_code_or_die("firstLang", $firstLang) if $firstLang;
      $self->{SPKR_CAT}->{$id}->{"educ"}      = find_code_or_die("educ", $educ) if $educ;
      $self->{SPKR_CAT}->{$id}->{"soc"}       = find_code_or_die("soc", $soc) if $soc;
      $self->{SPKR_CAT}->{$id}->{"sex"}       = find_code_or_die("sex", $sex) if $sex;
      $self->{SPKR_META}->{$id} = {};
      $self->{SPKR_META}->{$id}->{"role"} = encode_string($role || "N/A", $encoding);
      $self->{SPKR_META}->{$id}->{"age"} = encode_string($age || "N/A", $encoding);
      $self->{SPKR_META}->{$id}->{"name"} = encode_string($name || "N/A", $encoding);
      $self->{SPKR_META}->{$id}->{"occupation"} = encode_string($occupation || "N/A", $encoding);
      $self->{SPKR_META}->{$id}->{"n_words"} = 0;  # count number of tokens, words, <w>, <c>, <s>-units and <u>-units for each speaker
      $self->{SPKR_META}->{$id}->{"n_tokens"} = 0;
      $self->{SPKR_META}->{$id}->{"n_w"} = 0;
      $self->{SPKR_META}->{$id}->{"n_c"} = 0;
      $self->{SPKR_META}->{$id}->{"n_u"} = 0;
      $self->{SPKR_META}->{$id}->{"n_s"} = 0;
    }
    elsif ($att eq "SETTING") {
      my $id = $val;
      my ($n, $who, $date, $locale, $activity, $placeName) = @F;
      my @speakers = split " ", $who;
      @speakers = map {
        my $new_id = $spkr_id_map{$_};
        warn "BNC::Doc: setting $id involves undeclared speaker $_ (ignored)\n"
          unless $new_id;
        ($new_id) ? $new_id : $id; } @speakers;
      $who = "@speakers";
      $self->{TEXT_META}->{"settings"}->{$id} = [$id, $n, $who, $date, $locale, $activity, $placeName];
    }
    else {
      die "BNC::Doc: no handler for header item '$att' (file $filename)\n";
    }
  }

  my $ID = $self->{TEXT_META}->{"id"};
  die "BNC::Doc: file $filename has no document ID -- giving up\n"
    unless $ID;

  my $count_words = 0;    # validate number of words, <w> elements and <s>-units specified in metadata
  my $count_tokens = 0;   # produce additional counts for tokens and <c> elements
  my $count_w = 0;
  my $count_c = 0;
  my $count_s = 0;
  $self->{TEXT_META}->{"n_tokens"} = 0; # count all tokens as well (= size of corpus in CWB)

  my $last_token = undef; # reference to most recent token entry added to body (to update flags and whitespace information)
  my $last_mw = undef;    # reference to start tag of open <mw> group (to insert mw lemma), undef outside <mw> element
  my @mw_lemma = ();      # collect normalised word forms for <mw lemma="..."> and <mw hw="..."> attributes
  my %flags = ();         # collect flags for flags_before attribute of next token (will be compiled into feature set)
  my $last_ws_type = 0;   # keep track of "whitespace type" of previous token (if punctuation), for improved whitespace corrections
  my $tags_before = $tags_init; # collect all XML tags before next token
  my $last_tags_after = undef;  # reference to tags_after field of most recent token entry (so following closing tags can be added)
  my $add_to_tags_after = 0;    # if True, add tag to tags_after field of previous token; otherwise collect in $tags_before for next token
  my $current_speaker = undef;  # speaker ID of current speaker (for speaker statistics)
  my $offset = 0;         # offset of <w> or <c> element in original XML file
  my $within_s = 0;       # used to reject special type "x" tokens outside <s>-units

  READ_BODY:
  while (my $type_line = $self->readline) { # read body lines (either tokens or XML tags)
    my ($type, $line) = @$type_line;
    $_ = $line; # keep regexp matches and substitutions below simple

    if ($type eq "") {                            # ==== XML tags
      if (/^<\/([A-Za-z0-9]+)>/) {                # ------ close tag
        my $tag = $1;
        last if $tag eq "root"; # </root> marks end of body
        push @{ $self->{BODY} }, $_;

        if ($tag eq "s") {
          $last_token->[7] = $space_after_yes; # implicit whitespace after end of s-unit
          $within_s = 0;
        }
        elsif ($tag eq "mw") {
          my $hw = encode_string("@mw_lemma", $encoding);
          $$last_mw =~ /c5=["']([A-Z0-9-]+)["']/
            or die "BNC::Doc: no POS tag for MWU in ``$$last_mw'' [$ID]\n";
          my $pos = $1;
          my $class = pos2class($pos);
          my $lemma = $hw."_".$class;
          $$last_mw = encode_string("<mw pos=\"$pos\" lemma=\"$lemma\" hw=\"$hw\" class=\"$class\">", $encoding);
          @mw_lemma = ();
          $last_mw = undef;
        }
        elsif ($tag eq "u") {
          $current_speaker = undef;
        }

        # warn "BNC::Doc: no clear split of close/open tags between tokens, may be inconsisten [$ID]\n"
        #   unless $add_to_tags_after;
        my $encoded_tag = encode_tag($_, $encoding);
        if ($add_to_tags_after) {
          $$last_tags_after .= $encoded_tag; # normally, attach close tag to tags_after attribute of previous token
        }
        else {
          $tags_before .= $encoded_tag; # after the first open tag in the sequence, we attach all following tags to the next token
        }
      }
      elsif (/^<([A-Za-z0-9]+)/) {                # ------ open tag
        my $tag = $1;
        push @{ $self->{BODY} }, encode_string($_, $encoding);

        if ($tag eq "s") {
          $flags{"space"} = 1; # implicit whitespace before start of s-unit
          $count_s++;
          $offset = 0;
          $within_s = 1;
          if ($current_speaker) {
            $self->{SPKR_META}->{$current_speaker}->{"n_s"}++;
          }
        }
        elsif ($tag eq "mw") {
          $last_mw = \ ${ $self->{BODY} }[-1]; # reference to line just pushed on BODY stack
          $count_words++;
          if ($current_speaker) {
            $self->{SPKR_META}->{$current_speaker}->{"n_words"}++;
          }
          @mw_lemma = ();
        }
        elsif ($tag eq "u") {
          /who=["']([A-Z0-9]+)["']/
            or die "BNC::Doc: speaker not specified in tag ``$_'' [$ID]\n";
          $current_speaker = $1;
          if ($current_speaker eq "PS001") {
            $current_speaker = $ID.$current_speaker; # ensure that speaker IDs are unique (PS001 appears in three files)
            s/who=["'][A-Z0-9]+["']/who="$current_speaker"/; # fix <u who="XXX"> tag and replace old version in body array
            $self->{BODY}->[-1] = encode_string($_, $encoding);
          }
          unless (exists $self->{SPKR_CAT}->{$current_speaker}) {
            warn "BNC::Doc: inventing undeclared speaker $current_speaker [$ID]\n";
            $self->{SPKR_CAT}->{$current_speaker} = speaker_cat_table();
            $self->{SPKR_META}->{$current_speaker}->{"n_words"} = 0;
            $self->{SPKR_META}->{$current_speaker}->{"n_tokens"} = 0;
            $self->{SPKR_META}->{$current_speaker}->{"n_w"} = 0;
            $self->{SPKR_META}->{$current_speaker}->{"n_c"} = 0;
            $self->{SPKR_META}->{$current_speaker}->{"n_u"} = 0;
            $self->{SPKR_META}->{$current_speaker}->{"n_s"} = 0;
          }
          $self->{SPKR_META}->{$current_speaker}->{"n_u"}++;
        }

        $add_to_tags_after = 0; # opening tags are always attached to the following token (in tags_before attribute)
        $tags_before .= encode_tag($_, $encoding);
      }
      else {
        die "BNC::Doc: internal error -- line ``$line'' is not a valid XML tag (in file $filename)\n";
      }
    }
    elsif ($type eq "ANCHOR") {                   # ==== anchor tag (empty XML element)
      my ($anchor, @att) = split /\t/;
      my $tag = "<".join(" ", $anchor, @att)."/>"; # reconstruct XML tag for "anchors" attribute
      my $encoded_tag = encode_tag($tag, $encoding); # convert to suitable encoding for tags_before / tags_after attribute
      if ($add_to_tags_after) {
        $$last_tags_after .= $encoded_tag;
      }
      else {
        $tags_before .= $encoded_tag;
      }

      foreach (@att) { tr/"//d; s/\s+/_/g; }; # remove quotes and translate whitespace to underscores for simpler flag representation
      my $flag = join(":", $anchor, @att);
      $flags{ encode_string($flag, $encoding) } = 1;
    }
    elsif ($type eq "TOKEN") {                    # ==== token = (word, pos, hw, class, type)
      my ($word, $pos, $hw, $class, $type) = split /\t/;
      my ($need_space_before, $need_space_after, $ws_type) = (0, 0, 0); # flags indicate whether whitespace may need to be inserted (around <c> tokens)
      ## check whether whitespace is required before/after punctuation character (type <c> token), so BNC format errors can be repaired
      if ($type eq "c") {
        ($ws_type, $need_space_before, $need_space_after) = check_whitespace_type($word);
        if ($ws_type == 2 and $last_ws_type == 2) {
          $need_space_before = 0; # no whitespace inserted between adjacent "open" type punctuation characters
        }
        if ($ws_type == 1) {
          my $item = $self->lookahead_token; # "close" type punctuation -> don't insert whitespace if following token (lookahead) is also "close" punctuation
          if ($item) {
            my ($next_word, undef, undef, undef, $next_type) = split /\t/, $item->[1];
            if ($next_type eq "c") {
              my ($next_ws_type) = check_whitespace_type($next_word);
              $need_space_after = 0 if $next_ws_type == 1;
            }
          }
        }
        ## insert whitespace after previous token if necessary
        if ($need_space_before and not $flags{"space"}) {
          $last_token->[7] = $space_after_yes; # repair missing whitespace before this punctuation character
          $flags{"space"} = $flags{"space:insert"} = 1;
        }
        ## check for superfluous whitespace before punctuation that usually attaches to preceding word (whitespace type (0,1))
        if ($need_space_after and not $need_space_before) {
          if ($last_tags_after and $$last_tags_after eq $tags_init."<shift/>" and $flags{"space"}) {
            delete $flags{"space"}; # preceding whitespace is probably bogus (caused by empty <shift/> element) and should be removed
            $last_token->[7] = $space_after_no;
            $flags{"space:delete"} = 1;
          }
        }
        ## remember "whitespace type" of current token to avoid incorrect insertion of whitespace between tokens of same type
        $last_ws_type = $ws_type;
      }
      else {
        $last_ws_type = 0; # no "whitespace type" for word tokens
      }

      ## remove whitespace from token and code in flags / space_after attribute
      my $space_after = ($word =~ s/\s+$//) ? $space_after_yes : $space_after_no;
      if ($word =~ s/^\s+// and not $flags{"space"}) {
        $flags{"space"} = 1; # sometimes, whitespace is attached to the beginning of the following word (yuck!)
        $flags{"space:leading"} = 1;
        $last_token->[7] = $space_after_yes;  # update space_after attribute of previous token
      }
      ## make sure there is (virtual) whitespace around anchors inserted as tokens
      if ($type eq "x") {
        next READ_BODY unless $within_s;           # ignore special tokens (type "x") outside <s>-units
        if (not $flags{"space"}) {
          $flags{"space"} = $flags{"space:anchor"} = 1; # will be passed through to following "ordinary" token
          $last_token->[7] = $space_after_yes; # update space_after attribute of previous token
        }
        $need_space_after = 1;     # make sure we insert whitespace after this token
      }
      ## skip empty <w> tokens (some <w> elements just consist of a single blank)
      if ($word eq "") {
        $offset++;                 # but increment offset (which identifies <w> and <c> elements in original XML files)
        next READ_BODY;
      }
      ## some MWUs haven't been converted properly and are still present as <w> elements with internal whitespace
      if ($word =~ /\s/) {
        warn "BNC::Doc: unexpected whitespace in token '$word' [$ID]\n\t``$_''\n";
        $word =~ s/\s+/_/g;        # MWUs that haven't been split or other tokenisation errors
        $word = "[mw:".$word."]";  # translate to special form so we can recognise and correct them later
        $hw =~ s/\s+/_/g;          # lemma will probably also contain whitespace
        $hw = "[mw:".$hw."]";
      }
      ## if the current token is part of a <mw> element, build up MWU "lemma"
      if ($last_mw) {
        push @mw_lemma, lc($word); # should perform a Unicode lowercase operation
      }
      ## now convert word form and headword to the chosen encoding, and compile the flags attribute
      $word = encode_string($word, $encoding);
      $hw = encode_string($hw, $encoding);
      my $lemma = $hw."_".$class;
      my $flags_before = "|space|"; # construct feature set from accumulated flags (but not for "x" tokens, which just indicate implicit whitespace)
      if ($type ne "x") {
        ## should use CWB::CL::make_set() here, but we want to avoid dependency on CWB::CL module
        ## (NB: this may give the wrong sort order, so unify() isn't guaranteed to work!)
        $flags_before = "|".join("", map {
            s/\|/&#124;/g; # escape vertical bars in flags as HTML entities
            "$_|";
          } sort keys %flags);
        %flags = ();
      }
      ## check whether missing whitespace after current token has to be repaired
      if ($need_space_after and $space_after ne $space_after_yes) {
        $flags{"space:insert"} = 1;
        $space_after = $space_after_yes;
      }
      ## push the new token on the document body list (with special treatment for type "x" tokens)
      if ($type eq "x") {
        push @{ $self->{BODY} }, [ $word, $pos, $lemma, $hw, $class, $type, $flags_before, $space_after, $tags_init, $tags_init, $offset ];
        ## special type "x" tokens represent deleted material and are "invisible" for flags and reconstruction of original XML
      }
      else {
        my $new_token = [ $word, $pos, $lemma, $hw, $class, $type, $flags_before, $space_after, $tags_before, $tags_init, $offset ];
        push @{ $self->{BODY} }, $new_token;
        $last_token = $new_token;                    # pointer to previous token in body list
        $last_tags_after = \ ${ $new_token }[-2];    # pointer to tags_after attribute of previous token
        $tags_before = $tags_init;                   # reinit tags_before attribute for next token
        $add_to_tags_after = 1;                      # add following closing tags to previous token
      } 
      $flags{"space"} = 1 if $space_after eq $space_after_yes; # mark whitespace in flags for following token
      ## update token counts and offset
      $offset++ unless $type eq "x";
      $count_tokens++;
      $count_c++ if $type eq "c";
      if ($current_speaker) {
        $self->{SPKR_META}->{$current_speaker}->{"n_tokens"}++;
        $self->{SPKR_META}->{$current_speaker}->{"n_c"}++ if $type eq "c";
      }
      if ($type eq "w") {
        $count_w++;
        $count_words++ unless $last_mw;
        if ($current_speaker) {
          $self->{SPKR_META}->{$current_speaker}->{"n_w"}++;
          $self->{SPKR_META}->{$current_speaker}->{"n_words"}++ unless $last_mw;
        }
      }
    }
    else {
      die "BNC::Doc: internal error -- unknown line type '$type' (in file $filename)\n";
    }
  }
  die "BNC::Doc: unexpected junk at end of file $filename\n" if $self->readline;
  $pipe->close;
  $self->{PIPE} = undef;
  $self->{EOF} = -1;

  if ($tags_before ne $tags_init) {
    $tags_before =~ s/^$tags_init//; # open tags after last tokens (probably an XML element containing just an anchor item)
    $$last_tags_after .= $tags_before; # attach to last token in the text
  }

  ## # Don't print warnings -- the counts in file headers are almost always incorrect
  ## my $n_words = $self->{TEXT_META}->{"n_words"};
  ## my $n_w = $self->{TEXT_META}->{"n_w"};
  ## my $n_s = $self->{TEXT_META}->{"n_s"};
  ##   warn "\nBNC::Doc: incorrect word count in $filename -- $n_words (header) vs. $count_words (real)\n"
  ##     unless $n_words == $count_words;
  ##   warn "\nBNC::Doc: incorrect <w> count in $filename -- $n_w (header) vs. $count_w (real)\n"
  ##     unless $n_w == $count_w;
  ##   warn "\nBNC::Doc: incorrect <s> count in $filename -- $n_s (header) vs. $count_s (real)\n"
  ##     unless $n_s == $count_s;
  $self->{TEXT_META}->{"n_words"} = $count_words; # use correct token counts rather than values specified in header
  $self->{TEXT_META}->{"n_tokens"} = $count_tokens;
  $self->{TEXT_META}->{"n_w"} = $count_w;
  $self->{TEXT_META}->{"n_c"} = $count_c;
  $self->{TEXT_META}->{"n_s"} = $count_s;

  $self->{FILENAME} = $filename;
}

## internal helper method: read line from internal buffer (only in text body)
##   [$type, $line] = $self->readline; # $type = "" for XML tags, returns undef at EOF
sub readline ( $ ) {
  my $self = shift;
  unless (@{ $self->{LINE_BUFFER} }) {
    my $ok = $self->fill_buffer;
    return undef unless $ok;
  }
  return shift @{ $self->{LINE_BUFFER} };
}

## internal helper method: lookahead for next token
sub lookahead_token ( $ ) {
  my $self = shift;
  while (1) {
    my @tokens = grep { $_->[0] eq "TOKEN" } @{ $self->{LINE_BUFFER} };
    return shift @tokens
      if @tokens;
    return undef
      unless $self->fill_buffer;
  }
}

## internal helper method: read a few additional lines from pipe and add to buffer, returns number of lines added to buffer
sub fill_buffer ( $;$ ) {
  my $self = shift;
  my $n_remaining = (@_) ? shift : 10;
  my $n_read = 0;

  return 0 if $self->{EOF};
  while ($n_remaining > 0) {
    my $line = $self->{PIPE}->getline;
    unless ($line) {
      $self->{EOF} = 1;
      last;
    }
    chomp($line);
    if ($line =~ s/^(ANCHOR|TOKEN)\t//) {
      push @{ $self->{LINE_BUFFER} }, [$1, $line];
    }
    elsif ($line =~ /^</) {
      push @{ $self->{LINE_BUFFER} }, ["", $line];
    }
    elsif ($line =~ s/^WARN\t//) {
      warn "BNC::Doc: XML element <$_> is not handled by XSLT stylesheet yet [", $self->{TEXT_MEDA}->{"id"}, "]\n";
      next;
    }
    else {
      die "BNC::Doc: format error in body of file ", $self->{FILENAME}, ":\n\t``$_''\n";
    }
    $n_read++;
    $n_remaining--;
  }
  return $n_read;
}

## internal helper function: transform string into specified character encoding
##   unsafe characters should have already been encoded as entities by the XSLT processor
sub encode_string ( $$ ) {
  my ($s, $mode) = @_;

  $s = "" unless defined $s;    # just in case, to avoid lots of nasty warnings
  if ($mode eq "utf8") {
    return encode("utf8", $s);
  }
  elsif ($mode eq "html") {
    encode_entities($s, '^\x{00}-\x{FF}');
    return encode("iso-8859-1", $s);
  }
  elsif ($mode eq "mapped") {
    ## translate some common Unicode symbols to ASCII/Latin1
    $s =~ s/\N{VULGAR FRACTION ONE HALF}/{1\/2}/g;
    $s =~ s/\N{VULGAR FRACTION ONE QUARTER}/{1\/4}/g;
    $s =~ s/\N{VULGAR FRACTION THREE QUARTERS}/{3\/4}/g;
    $s =~ s/\N{VULGAR FRACTION ONE THIRD}/{1\/3}/g;
    $s =~ s/\N{VULGAR FRACTION TWO THIRDS}/{2\/3}/g;
    $s =~ s/\N{VULGAR FRACTION ONE FIFTH}/{1\/5}/g;
    $s =~ s/\N{VULGAR FRACTION TWO FIFTHS}/{2\/5}/g;
    $s =~ s/\N{VULGAR FRACTION THREE FIFTHS}/{3\/5}/g;
    $s =~ s/\N{VULGAR FRACTION FOUR FIFTHS}/{4\/5}/g;
    $s =~ s/\N{VULGAR FRACTION ONE SIXTH}/{1\/6}/g;
    $s =~ s/\N{VULGAR FRACTION FIVE SIXTHS}/{5\/6}/g;
    $s =~ s/\N{VULGAR FRACTION ONE EIGHTH}/{1\/8}/g;
    $s =~ s/\N{VULGAR FRACTION THREE EIGHTHS}/{3\/8}/g;
    $s =~ s/\N{VULGAR FRACTION FIVE EIGHTHS}/{5\/8}/g;
    $s =~ s/\N{VULGAR FRACTION SEVEN EIGHTHS}/{7\/8}/g;
    $s =~ s/\N{GREATER-THAN OR EQUAL TO}/>=/g;
    $s =~ s/\N{LESS-THAN OR EQUAL TO}/<=/g;
    $s =~ s/\N{HORIZONTAL ELLIPSIS}/.../g;
    $s =~ s/\N{LEFTWARDS ARROW}/<-/g;
    $s =~ s/\N{RIGHTWARDS ARROW}/->/g;
    $s =~ s/\N{ASTERISK OPERATOR}/*/g;
    $s =~ s/\N{LEFT SINGLE QUOTATION MARK}/``/g;
    $s =~ s/\N{RIGHT SINGLE QUOTATION MARK}/''/g;
    $s =~ s/\N{EM DASH}/---/g;
    $s =~ s/\N{EN DASH}/--/g;
    $s =~ s/\N{LATIN CAPITAL LIGATURE OE}/OE/g;
    $s =~ s/\N{LATIN SMALL LIGATURE OE}/oe/g;
    $s =~ s/\N{PRIME}/'/g;
    $s =~ s/\N{DOUBLE PRIME}/''/g;
    $s =~ s/\N{TILDE OPERATOR}/~/g;
    $s =~ s/\N{TRADE MARK SIGN}/{TM}/g;
    ## any remaining non-latin characters are translated to Unicode names
    $s =~ s/[^\x{00}-\x{FF}]/"{".charnames::viacode(ord($&))."}"/ge;
    return encode("iso-8859-1", $s);
  }
  die "BNC::Doc: unknown/unsupported character encoding '$mode'\n";
}

## internal helper function: encode XML tag for storage in positional attribute
sub encode_tag ( $$ ) {
  my ($s, $mode) = @_;
  $s =~ s/\s+/ /g; # normalise whitespace 
  return encode_string($s, $mode); # return in selected encoding
}

## internal helper function: map POS tag to simplified word class (for <mw> elements)
sub pos2class ( $ ) {
  my $pos = shift;
  ## this is done according to the BNC Reference Guide (Sec. 9.8) -- the actual usage in BNC files differs!
  return "ADJ" if /^(AJ.|CRD|DT0|ORD)$/;
  return "ADV" if /^(AV.|XX0)$/;
  return "ART" if /^(AT0)$/;
  return "CONJ" if /^(CJ.)$/;
  return "INTERJ" if /^(ITJ)$/;
  return "PREP" if /^(PR.|TO0)$/;
  return "PRON" if /^(DT[SQ]|EX0|PN.)$/;
  return "STOP" if /^(POS|PU.)$/;
  return "SUBST" if /^(N[NP].|ZZ0|NN1-NP0|NP0-NN1)$/;
  return "VERB" if /^(V..|VVD-VVN|VVN-VVD)$/;
  return "UNC"; # everything else is UNC
}

## internal helper function: check "whitespace-category" of punctuation character (NB: argument must be Unicode string)
##   ($ws_type, $space_before, $space_after) = check_whitespace_type($char);
## [$ws_type: 1 = 'open' punctuation, 2 = 'close' punctuation, 3 = 'mid' punctuation, 0 = no whitespace required]
sub check_whitespace_type ( $ ) {
  my $char = shift;
  $char =~ s/\s//g; # clean up trailing or leading whitespace
  return (1, 0, 1) if $char =~ /^[,:;.?!)\]}\N{RIGHT SINGLE QUOTATION MARK}\N{RIGHT DOUBLE QUOTATION MARK}]$/;
  return (2, 1, 0) if $char =~ /^[(\[{\N{LEFT SINGLE QUOTATION MARK}\N{LEFT DOUBLE QUOTATION MARK}]$/;
  return (3, 1, 1) if $char =~ /^[\-\N{EN DASH}\N{EM DASH}\N{HORIZONTAL ELLIPSIS}]$/;
  return (0, 0, 0);  # character not in list
}

=item $att_val_hash = $text->text_cat;

Return text categories for I<$text> as hash, with short taxonomy names as keys and the corresponding categories (strings) as values.

List of taxonomy names:

    audience_age      Audience age
    audience_sex      Audience sex
    author_age        Author age-group
    author_domicile   Domicile of author
    author_sex        Sex of author
    author_type       Author type
    availability      Availability
    circulation       Estimated circulation size
    context           Spoken context
    derived_type      Text class
    difficulty        Written difficulty
    domain            Written domain
    genre             David Lee's genre classification
    interaction_type  Interaction type
    medium            Written medium
    mode              Text mode
    publication_date  Publication date
    publication_place Publication place
    region            Region
    respondent_age    Age-group of respondent
    respondent_class  Social class of respondent (NRS social grades)
    respondent_sex    Sex of respondent
    sampling_type     Sampling type
    text_type         Text type

=cut

sub text_cat ( $ ) {
  my $self = shift;
  my $retval = {};
  my ($att, $val);
  while (($att, $val) = each %{$self->{TEXT_CAT}}) {
    $retval->{ $TextCat{$att}{NAME} } = $val->{NAME};
  }
  return $retval;
}

=item $att_val_hash = $text->text_cat_numeric;

Return text categories for I<$text> as hash, with original BNC taxonomy names/codes as keys and the corresponding numeric category IDs as values.
For categories that are coded numerically in the original BNC metadata, the ID numbers are preserved;
otherwise, sequential non-negative integer IDs have been assigned.

List of BNC taxonomy codes:

    ALLTIM          Publication date
    ALLTYP          Text type
    SCGDOM          Spoken context
    SDEAGE          Age-group of respondent
    SDECLA          Social class of respondent (NRS social grades)
    SDESEX          Sex of respondent
    SPOLOG          Interaction type
    SPOREG          Region
    SPOWRI          Text mode (spoken or written)
    WRIAAG          Author age-group
    WRIAD           Domicile of author
    WRIASE          Sex of author
    WRIATY          Author type
    WRIAUD          Audience age
    WRIDOM          Written domain
    WRILEV          Written difficulty
    WRIMED          Written medium
    WRIPP           Publication place
    WRISAM          Sampling type
    WRISTA          Estimated circulation size
    WRITAS          Audience sex
    allava          Availability
    DLee            David Lee's genre classification
    derivedTextType Text class
    textMode        Text mode (spoken or written)

=cut

sub text_cat_numeric ( $ ) {
  my $self = shift;
  my $retval = {};
  my ($att, $val);
  while (($att, $val) = each %{$self->{TEXT_CAT}}) {
    $retval->{ $att } = $val->{NUM};
  }
  return $retval;
}

=item $value = $text->text_meta($att [, $default]);

Access free-form metadata for I<$text> (returns string value of attribute I<$att>).
For missing data, either B<undef> or the optional default value I<$default> is returned.

The following meta-information should be provided for most texts:

    id          BNC document ID
    title       Full title of the BNC document
    n_words     Size of text in words (where MWU count as a single word)
    n_tokens    Number of tokens = size of text in CWB
    n_w         Number of <w>-units in text
    n_s         Number of <s>-units in text

The values of C<n_words>, C<n_w> and C<n_s> are actual counts from the document body rather than those
given in the file header (which are usually more or less off).

For spoken texts with setting descriptions, the meta-information field C<settings> contains
a hash mapping setting IDs to anonymous arrays with the attributes 
I<S<setting ID>>, I<number>, I<S<speaker list>>, I<date>, I<locale>, I<activity> and I<S<place name>>
in this order.  Missing values are encoded as empty strings in the array.

=cut

sub text_meta ( $$;$ ) {
  my ($self, $att, $default) = @_;
  my $val = $self->{TEXT_META}->{$att};
  return (defined $val) ? $val : $default;
}

=item @speaker_ids = $text->sepakers;

Returns list of speaker IDs declared in the header of a spoken text, empty list for a written text.

=cut

sub speakers ( $ ) {
  my $self = shift;
  return sort keys %{ $self->{SPKR_CAT} }
}

=item $att_val_hash = $text->speaker_cat($id);

Returns formalised speaker attributes for speaker I<$id> in I<$text> as a hash,
mapping short attribute names to the corresponding values (given as descriptive category names).

List of speaker attribute names:

    age_group      Age-group of speaker
    class          Social class of the speaker
    dialect        Dialect of speaker
    education      Age at which speaker ceased full-time education
    first_language First language of speaker
    sex            Sex of speaker

=cut

sub speaker_cat ( $$ ) {
  my ($self, $id) = @_;
  my $retval = {};
  my ($att, $val);
  while (($att, $val) = each %{ $self->{SPKR_CAT}->{$id} }) {
    $retval->{ $SpkrCat{$att}{NAME} } = $val->{NAME};
  }
  return $retval;
}

=item $att_val_hash = $text->speaker_cat_numeric($id);

Returns formalised speaker attributes for speaker I<$id> in I<$text> as a hash,
mapping BNC attribute names to the corresponding values (given as numeric category IDs).
Since speaker attributes are not coded numerically in the original BNC metadata,
sequential non-negative integers have been assigned to the categories in a "natural" order.

List of BNC speaker attribute codes:

    ageGroup  Age-group of speaker
    dialect   Dialect of speaker
    educ      Age at which speaker ceased full-time education
    firstLang First language of speaker
    sex       Sex of speaker
    soc       Social class of the speaker

=cut

sub speaker_cat_numeric ( $$ ) {
  my ($self, $id) = @_;
  my $retval = {};
  my ($att, $val);
  while (($att, $val) = each %{ $self->{SPKR_CAT}->{$id} }) {
    $retval->{ $att } = $val->{NUM};
  }
  return $retval;
}

=item $value = $text->speaker_meta($id, $att [, $default]);
Access free-form metadata for speaker I<$id> in I<$text> (returns string value of attribute I<$att>).
For missing data, either B<undef> or the optional default value I<$default> is returned.

The following meta-information may be provided:

    age         Age of the speaker (more precise than age group)
    name        Name of the speaker
    occupation  Description of speaker's occupation
    role        Role of speaker in the conversation
    n_words     Number of words contributed by the speaker
    n_tokens    Number of tokens
    n_w         Number of <w> elements
    n_c         Number of <c> elements
    n_u         Number of utterances (<u> elements)
    n_s         Number of <s>-units

=cut

sub speaker_meta ( $$$;$ ) {
  my ($self, $id, $att, $default) = @_;
  my $val = $self->{SPKR_META}->{$id}->{$att};
  return (defined $val) ? $val : $default;
}

=item $lines = $text->body;

Returns reference to array of body text lines, where each line is either of:

=over 4

=item a)

An opening or closing B<XML tag>, given as a single string in the selected encoding.

=item b)

A B<token> represented by an anonymous array with the fields 0 = I<word form>,
1 = I<pos tag>, 2 = I<lemma> (= I<hw>_I<class>), 3 = I<headword>, 4 = I<word class>,
5 = I<type> (C<w>, C<c> or C<x>), 6 = I<flags before token> (feature set),
7 = I<whitespace after token>, 8 = XML I<tags before token>, 9 = XML I<tags after token> 
and 10 = token I<offset> (counting both C<< <w> >> and C<< <c> >> elements in original
XML from start of current C<< <s> >>-unit). Any string that may contain non-ASCII
characters has been translated into the specified encoding.

Field 7 (whitespace after token) is encoded with the special strings C</\x{A0}> (no whitespace) and
C</\x{A0}\x{A0}> (whitespace), which allow for easy splitting and post-processing of CQP's C<cat> output
within BNCweb (C<\x{A0}> is a non-breaking space character).
Fields 8 and 9 (XML tags before and after the token) are used to reconstruct the original XML sources
more easily and reliably than from tags encoded as s-attributes.  They use a format similar to
the I<whitespace after token> field, starting with the delimiter C</\x{A0}> and followed by a
concatenation of empty-element XML tags in which all whitespace has been converted to non-breaking spaces
(again to ease splitting and post-processing of C<cat> output).

=back

=cut

sub body ( $ ) {
  my $self = shift;
  return $self->{BODY};
}

=back

=head1 AUTHOR

Stefan Evert E<lt>stefan.evert@uos.deE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2007 by Stefan Evert

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.6 or,
at your option, any later version of Perl 5 you may have available.

=cut

1;

__DATA__
<?xml version="1.0" encoding="UTF-8"?>
<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
<xsl:output method="xml" version="1.0" encoding="UTF-8" indent="no"/>
<xsl:strip-space elements="*"/>

<!-- print bncDoc header information on separate lines, then file body with XML tags and token lines --> 
<xsl:template match="bncDoc">
<root>  <!-- insert wrapper element so that output is a well-formed XML document -->
<xsl:text>&#10;</xsl:text>
<xsl:text>ID&#9;</xsl:text>      <!-- document ID -->
<xsl:value-of select="@xml:id"/>
<xsl:text>&#10;</xsl:text>
<xsl:text>TITLE&#9;</xsl:text>   <!-- title of the document -->
<xsl:value-of select="normalize-space(teiHeader/fileDesc/titleStmt/title)"/>
<xsl:text>&#10;</xsl:text>
<xsl:text>SIZE&#9;</xsl:text>    <!-- size information (must be parsed by Perl code) -->
<xsl:value-of select="normalize-space(teiHeader/fileDesc/extent)"/>
<xsl:text>&#10;</xsl:text>
<xsl:text>CATREF&#9;</xsl:text>  <!-- BNC text classification (category references) -->
<xsl:value-of select="normalize-space(teiHeader/profileDesc/textClass/catRef/@targets)"/>
<xsl:text>&#10;</xsl:text>
<xsl:text>DLEE&#9;</xsl:text>    <!-- David Lee's genre classification -->
<xsl:value-of select="normalize-space(teiHeader/profileDesc/textClass/classCode[@scheme='DLEE'])"/>
<xsl:text>&#10;</xsl:text>
<xsl:for-each select="teiHeader/profileDesc/textClass/keywords[@scheme='COPAC']/term">  <!-- COPAC keywords -->
  <xsl:text>KEYWORD&#9;COPAC&#9;</xsl:text>   
  <xsl:value-of select="normalize-space(.)"/>
  <xsl:text>&#10;</xsl:text>
</xsl:for-each>
<xsl:for-each select="teiHeader/profileDesc/textClass/keywords[not(@scheme)]/term">  <!-- other keywords -->
  <xsl:text>KEYWORD&#9;other&#9;</xsl:text>
  <xsl:value-of select="normalize-space(.)"/>
  <xsl:text>&#10;</xsl:text>
</xsl:for-each>
<xsl:text>TEXTTYPE&#9;</xsl:text>   <!-- derived text type -->
<xsl:value-of select="normalize-space(//wtext/@type|//stext/@type)"/>
<xsl:text>&#10;</xsl:text>
<xsl:for-each select="teiHeader/profileDesc/particDesc/person"> <!-- extract speaker information, if present -->
<xsl:text>SPEAKER&#9;</xsl:text> <!-- SPEAKER id ageGroup dialect firstLang educ soc sex role [age name occupation] -->
<xsl:value-of select="@xml:id"/>
<xsl:text>&#9;</xsl:text>
<xsl:value-of select="@ageGroup"/>
<xsl:text>&#9;</xsl:text>
<xsl:value-of select="@dialect"/>
<xsl:text>&#9;</xsl:text>
<xsl:value-of select="@firstLang"/>
<xsl:text>&#9;</xsl:text>
<xsl:value-of select="@educ"/>
<xsl:text>&#9;</xsl:text>
<xsl:value-of select="@soc"/>
<xsl:text>&#9;</xsl:text>
<xsl:value-of select="@sex"/>
<xsl:text>&#9;</xsl:text>
<xsl:value-of select="normalize-space(@role)"/>
<xsl:text>&#9;</xsl:text>
<xsl:value-of select="normalize-space(age)"/>
<xsl:text>&#9;</xsl:text>
<xsl:value-of select="normalize-space(persName)"/>
<xsl:text>&#9;</xsl:text>
<xsl:value-of select="normalize-space(occupation)"/>
<xsl:text>&#10;</xsl:text>
</xsl:for-each>
<xsl:for-each select="teiHeader/profileDesc/settingDesc/setting"> <!-- extract any setting descriptions -->
<xsl:text>SETTING&#9;</xsl:text> <!-- SETTING id n who date locale activity placeName -->
<xsl:value-of select="@xml:id"/>
<xsl:text>&#9;</xsl:text>
<xsl:value-of select="@n"/>
<xsl:text>&#9;</xsl:text>
<xsl:value-of select="normalize-space(@who)"/>
<xsl:text>&#9;</xsl:text>
<xsl:value-of select="normalize-space(date)"/>
<xsl:text>&#9;</xsl:text>
<xsl:value-of select="normalize-space(locale)"/>
<xsl:text>&#9;</xsl:text>
<xsl:value-of select="normalize-space(activity)"/>
<xsl:text>&#9;</xsl:text>
<xsl:value-of select="normalize-space(placeName)"/>
<xsl:text>&#10;</xsl:text>
</xsl:for-each>
<xsl:text>BODY&#10;</xsl:text>      <!-- mark end of header / start of bncDoc body -->
<!-- process document body, which is either a wtext or an stext element -->
<xsl:apply-templates select="//wtext|//stext"/>
</root>
</xsl:template>

<!-- print document body (within wtext or stext element), text or bncDoc wrapper will be inserted by Perl script -->
<xsl:template match="wtext|stext">
<xsl:apply-templates mode="body"/>
</xsl:template>

<!-- print TOKEN line for <w> and <c> elements -->
<xsl:template match="w" mode="body">
<xsl:text>TOKEN&#9;</xsl:text>      <!-- TOKEN -->
<xsl:value-of select="translate(.,'&#10;&#13;','  ')"/>     <!-- word (remove linebreaks) -->
<xsl:text>&#9;</xsl:text>
<xsl:value-of select="@c5"/>                                <!-- pos -->
<xsl:text>&#9;</xsl:text>
<xsl:value-of select="normalize-space(@hw)"/>               <!-- headword (without leading/trailing whitespace) -->
<xsl:text>&#9;</xsl:text>
<xsl:value-of select="@pos"/>                               <!-- class -->
<xsl:text>&#9;w</xsl:text>                                  <!-- type = w -->
<xsl:text>&#10;</xsl:text>
</xsl:template>

<xsl:template match="c" mode="body">
<xsl:text>TOKEN&#9;</xsl:text>      <!-- TOKEN -->
<xsl:value-of select="translate(.,'&#10;&#13;','  ')"/>     <!-- word (punctuation character, remove linebreaks) -->
<xsl:text>&#9;</xsl:text>
<xsl:value-of select="@c5"/>                                <!-- pos -->
<xsl:text>&#9;</xsl:text>
<xsl:value-of select="normalize-space(.)"/>                 <!-- headword = surface character (remove whitespace) -->
<xsl:text>&#9;</xsl:text>
<xsl:value-of select="'STOP'"/>                             <!-- class = STOP -->
<xsl:text>&#9;c</xsl:text>                                  <!-- type = c -->
<xsl:text>&#10;</xsl:text>
</xsl:template>

<!-- pass through XML markup (with all attributes):
        <div n=".. Description .." level="2" type="[chapter]">
        <head type="MAIN" rend="[..]"> 
        <quote rend="[..]">
        <sp who="Hamlet">
        <speaker>
        <stage rend="[..]">
        <lg>
        <l>
        <list>
        <label rend="[..]">
        <item rend="[..]">
        <note place="..." n="[internal id]">
        <bibl rend="[..]">
        <p>
        <u who="PS1LW">  [need special processing!]
        <s n="1">
        <corr sic="worng" rend="">
        <hi rend="it">
        <trunc>
        <mw c5="PRP">
-->
<xsl:template match="div|head|quote|sp|speaker|stage|lg|l|list|label|item|note|bibl|p|u|s|corr|hi|mw|trunc" mode="body">
<xsl:copy>
  <xsl:copy-of select="attribute::*"/>
  <xsl:text>&#10;</xsl:text>
  <xsl:apply-templates mode="body"/>
</xsl:copy>
<xsl:text>&#10;</xsl:text>
</xsl:template>

<!-- translate empty tags that serve as anchors into special ANCHOR lines:
        ANCHOR pb n=75
        ANCHOR event desc=radio on dur=2
        ANCHOR pause dur=4
        ANCHOR shift new=whisper
        ANCHOR align with=KNYLC01D
        ANCHOR vocal desc=laugh dur=3 who=PS09T
     also makes entries for tags that are (sometimes) inserted as additional tokens
        ANCHOR unclear dur=2 who=PS09T
        ANCHOR gap desc=name reason=anaonymization
-->
<xsl:template match="pb|event|pause|shift|align|unclear|vocal|gap" mode="body">
<xsl:text>ANCHOR&#9;</xsl:text>         <!-- ANCHOR -->
<xsl:value-of select="local-name()"/>                       <!-- anchor name -->
<xsl:for-each select="attribute::*">
<xsl:text>&#9;</xsl:text>
<xsl:value-of select="local-name()"/>                       <!-- att="value" -->
<xsl:text>=</xsl:text>
<xsl:text>&quot;</xsl:text>
<xsl:value-of select="normalize-space(.)"/>
<xsl:text>&quot;</xsl:text>
</xsl:for-each>
<xsl:text>&#10;</xsl:text>
<xsl:apply-templates select="." mode="anchor_token"/>
</xsl:template>

<!-- empty tags <gap/> and <unclear/> may be part of an utterance and are inserted as special tokens with class "x":
     <gap desc="name" reason="anonymization"/>
        =>  [gap:name] UNC [gap]_UNC     [gap]     UNC x
     <unclear dur="2" who="PS09T"/>
        =>  [unclear]  UNC [unclear]_UNC [unclear] UNC x
-->
<xsl:template match="gap[@reason='anonymization']" mode="anchor_token">
<xsl:text>TOKEN&#9;</xsl:text>         <!-- TOKEN -->
<xsl:text>[gap</xsl:text>                                   <!-- word = [gap:<desc>]<SPACE> -->
<xsl:if test="@desc">
  <xsl:text>:</xsl:text>
  <xsl:value-of select="translate(normalize-space(@desc),' ','_')"/>
</xsl:if>  
<xsl:text>] &#9;UNC&#9;</xsl:text>                          <!-- pos = UNC -->
<xsl:text>[gap]&#9;</xsl:text>                              <!-- hw = [gap] -->
<xsl:text>UNC&#9;</xsl:text>                                <!-- class = UNC -->
<xsl:text>x</xsl:text>                                      <!-- type = x -->
<xsl:text>&#10;</xsl:text>
</xsl:template>

<xsl:template match="unclear" mode="anchor_token">
<xsl:text>TOKEN&#9;</xsl:text>         <!-- TOKEN -->
<xsl:text>[unclear] &#9;</xsl:text>                         <!-- word = [unclear]<SPACE> -->
<xsl:text>UNC&#9;</xsl:text>                                <!-- pos = UNC -->
<xsl:text>[unclear]&#9;</xsl:text>                          <!-- hw = [unclear] -->
<xsl:text>UNC&#9;</xsl:text>                                <!-- class = UNC -->
<xsl:text>x</xsl:text>                                      <!-- type = x -->
<xsl:text>&#10;</xsl:text>
</xsl:template>

<!-- warn about unhandled elements (will be caught by Perl script) -->
<xsl:template match="*" mode="body">
<xsl:text>WARN&#9;</xsl:text>
<xsl:value-of select="local-name()"/>
<xsl:text>&#10;</xsl:text>
<xsl:apply-templates mode="body"/>
</xsl:template>

</xsl:stylesheet>
