## -*- Mode: CPerl -*-

## File: DTA::TokWrap::Processor::tcftokenize.pm
## Author: Bryan Jurish <moocow@cpan.org>
## Description: DTA tokenizer wrappers: TCF->TEI+ws decoding via proxy document

package DTA::TokWrap::Processor::tcftokenize;

use DTA::TokWrap::Version;  ##-- imports $VERSION, $RCDIR
use DTA::TokWrap::Base;
use DTA::TokWrap::Utils qw(:slurp :time :libxml);
use DTA::TokWrap::Processor;
use File::Basename qw(basename);

use Carp;
use strict;

##==============================================================================
## Constants
##==============================================================================
our @ISA = qw(DTA::TokWrap::Processor);

##==============================================================================
## Constructors etc.
##==============================================================================

## $ttok = CLASS_OR_OBJ->new(%args)
##  + %args: (none)

## %defaults = CLASS_OR_OBJ->defaults()
##  + called by constructor
##  + inherited dummy method
#sub defaults { qw() }

## $ttok = $ttok->init()
##  + inherited dummy method
#sub init { $_[0] }

##==============================================================================
## Methods
##==============================================================================

## $doc_or_undef = $CLASS_OR_OBJECT->tcftokenize($doc)
## + $doc is a DTA::TokWrap::Document object
## + %$doc keys:
##    tcfdoc    => $tcfdoc,       ##-- (input) TCF input document with <text> layer
##    ##
##    txtfile   => $txtfile,      ##-- (output,temp) text file used for TCF extraction
##    tokdata0  => $tokdata,      ##-- (output,temp) raw tokenization data
##    tokdata1  => $tokdata1,     ##-- (output,temp) tweaked tokenization data
##    ##
##    tcftokdoc => $tcftokdoc,    ##-- (output) output TCF file with <sentences>,<tokens> layers (==$tcfdoc)
##    tcftokenize_stamp0 => $f,    ##-- (output) timestamp of operation begin
##    tcftokenize_stamp  => $f,    ##-- (output) timestamp of operation end
##    tcftokdoc_stamp    => $f,    ##-- (output) timestamp of operation end
##    #...
sub tcftokenize {
  my ($ttok,$doc) = @_;
  $ttok = $ttok->new if (!ref($ttok));
  $doc->setLogContext();

  ##-- log, stamp
  $ttok->vlog($ttok->{traceLevel},"tcftokenize()");
  $doc->{tcftokenize_stamp0} = timestamp(); ##-- stamp

  ##-- sanity check(s)
  $ttok->logconfess("tcftokenize(): no {tcfdoc} defined") if (!defined($doc->{tcfdoc}));

  ##-- ensure text data, file
  $doc->tcfdecode0(undef, decode_tcfx=>0,decode_tcfw=>0,decode_tcft=>1)
    and defined($doc->{tcftdata})
      or $ttok->logconfess("tcftokenize(): failed to decode TCF text layer: $!");
  $doc->saveFileData('tcft','',$doc->{txtfile})
    or $ttok->logconfess("tcftokenize(): failed to create tokenizer input file '$doc->{txtfile}': $!");

  ##-- call underlying tokenizer
  $doc->genKey([qw(tokenize tokenize1)])
    or $ttok->logconfess("tcftokenize(): failed to tokenize TCF text layer: $!");

  ##-- parse tokenizer output into tcf (no sanity checking)
  my $tcfdoc = $doc->{tcfdoc};
  my $xroot  = $tcfdoc->documentElement;
  my $xcorpus = [$xroot->getChildrenByLocalName('TextCorpus')]->[0] // $xroot->addNewChild(undef,'TextCorpus');
  my $xtokens = $xcorpus->addNewChild(undef,'tokens');
  my $xsents  = $xcorpus->addNewChild(undef,'sentences');
  open(my $ttfh, "<", \$doc->{tokdata1})
    or $ttok->logconfess("open failed for tokenizer output buffer: $!");

  local ($_);
  my $wi = 0;
  my ($s,$wnod,$snod);
  my @sents = ($s=[]); ##-- ([$wi_start, $wi_end], ...)
  while (defined($_=<$ttfh>)) {
    chomp;
    if (/^%%/) {
      next;
    } elsif (/^$/) {
      push(@sents,$s=[]);
      next;
    }
    s/\t.*$//; ##-- trim tokenizer output
    ++$wi;
    $s->[0] = $wi if (!@$s);
    $s->[1] = $wi;
    $wnod = $xtokens->addNewChild(undef,'token');
    $wnod->setAttribute('ID'=>sprintf("w%x",$wi));
    $wnod->appendText($_);
  }

  ##-- append sentences
  my $si = 0;
  foreach (@sents) {
    next if (!@$_);
    $snod = $xsents->addNewChild(undef,'sentence');
    $snod->setAttribute('ID'=>sprintf("s%x",++$si));
    $snod->setAttribute('tokenIDs'=>join(' ', map {sprintf("w%x",$_)} ($_->[0]..$_->[1])));
  }

  ##-- finalize
  $ttok->vlog($ttok->{traceLevel},"tcftokenize(): finalize");
  $doc->{tcftokdoc} = $doc->{tcfdoc};
  $doc->{tcftokenize_stamp} = $doc->{tcftokdoc_stamp} = timestamp(); ##-- stamp
  return $doc;
}

##==============================================================================
## Utilities
##==============================================================================

1; ##-- be happy

__END__

##========================================================================
## POD DOCUMENTATION, auto-generated by podextract.perl, edited

##========================================================================
## NAME
=pod

=head1 NAME

DTA::TokWrap::Processor::tcftokenize - DTA tokenizer wrappers: TCF text layer tokenization

=cut

##========================================================================
## SYNOPSIS
=pod

=head1 SYNOPSIS

 use DTA::TokWrap::Processor::tcftokenize;
 
 $ttok = DTA::TokWrap::Processor::tcftokenize->new(%opts);
 $doc_or_undef = $ttok->tcftokenize($doc);

=cut

##========================================================================
## DESCRIPTION
=pod

=head1 DESCRIPTION

DTA::TokWrap::Processor::tcftokenize provides an object-oriented
L<DTA::TokWrap::Processor|DTA::TokWrap::Processor> wrapper
for tokenizing the TCF C<text> layer with the selected tokenizer
and encoding the result in the TCF C<tokens> and C<sentences> layers.

=cut

##----------------------------------------------------------------
## DESCRIPTION: DTA::TokWrap::Processor::tcftokenize: Constants
=pod

=head2 Constants

=over 4

=item @ISA

DTA::TokWrap::Processor::tcftokenize
inherits from
L<DTA::TokWrap::Processor|DTA::TokWrap::Processor>.

=back

=cut

##----------------------------------------------------------------
## DESCRIPTION: DTA::TokWrap::Processor::tcftokenize: Constructors etc.
=pod

=head2 Constructors etc.

=over 4

=item new

 $obj = $CLASS_OR_OBJECT->new(%args);

Constructor.

=item defaults

 %defaults = $CLASS->defaults();

Static class-dependent defaults.

=back

=cut

##----------------------------------------------------------------
## DESCRIPTION: DTA::TokWrap::Processor::tcftokenize: Methods
=pod

=head2 Methods

=over 4

=item tcftokenize

 $doc_or_undef = $CLASS_OR_OBJECT->tcftokenize($doc);

Tokenizes the C<text> layer extracted from a TCF document
and encodes the result in new TCF C<tokens> and C<sentences> layers.

Relevant %$doc keys:

 tcfdoc    => $tcfdoc,       ##-- (input,output) TCF input document with <text> layer
 ##
 txtfile   => $txtfile,      ##-- (temp,output) text file used for TCF extraction
 tokdata0  => $tokdata,      ##-- (temp,output) raw tokenization data
 tokdata1  => $tokdata1,     ##-- (temp,output) tweaked tokenization data
 ##
 tcftokdoc => $tcftokdoc,    ##-- (output) output TCF file with <sentences>,<tokens> layers (==$tcfdoc)
 tcftokenize_stamp0 => $f,   ##-- (output) timestamp of operation begin
 tcftokenize_stamp  => $f,   ##-- (output) timestamp of operation end
 tcftokdoc_stamp    => $f,   ##-- (output) timestamp of operation end

=back

=cut

##========================================================================
## END POD DOCUMENTATION, auto-generated by podextract.perl

##======================================================================
## See Also
##======================================================================

=pod

=head1 SEE ALSO

L<DTA::TokWrap::Intro(3pm)|DTA::TokWrap::Intro>,
L<dta-tokwrap.perl(1)|dta-tokwrap.perl>,
...

=cut

##======================================================================
## See Also
##======================================================================

=pod

=head1 SEE ALSO

L<DTA::TokWrap::Intro(3pm)|DTA::TokWrap::Intro>,
L<dta-tokwrap.perl(1)|dta-tokwrap.perl>,
...

=cut

##======================================================================
## Footer
##======================================================================

=pod

=head1 AUTHOR

Bryan Jurish E<lt>moocow@cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2014-2018 by Bryan Jurish

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

=cut


