File Coverage

blib/lib/Treex/PML/Backend/NTRED.pm

Criterion	Covered	Total	%
statement	22	66	33.3
branch	0	16	0.0
condition	0	6	0.0
subroutine	8	13	61.5
pod	0	5	0.0
total	30	106	28.3

package Treex::PML::Backend::NTRED;
use Treex::PML;
use Storable qw(nfreeze thaw);
use MIME::Base64;
use Treex::PML::IO;
use strict;

use vars qw($VERSION);
BEGIN {
  $VERSION='2.24'; # version template
}

use vars qw($ntred);


$ntred='ntred';

sub test {
  my ($filename,$encoding)=@_;
  return $filename=~m(^ntred://);
}

sub open_backend {
  my ($filename, $mode, $encoding)=@_;
  my $fh = undef;
  my $cmd = "";
  return unless $filename=~m(^ntred://(.*)$);
  $filename=$1;
  $filename=~s/@/##/;
  if ($filename) {
    if ($mode eq 'w') {
      open($fh,'|-',$ntred, '-Q', '--upload-file', $filename) || die "Failed to start NTrEd Client '$ntred': $!\n";
    } else {
      open($fh,'-|',$ntred, '-Q', '--dump-files', $filename) || die "Failed NTrEd Client '$ntred': $!\n";
    }
  }
  return Treex::PML::IO::set_encoding($fh,$encoding);
}

sub close_backend {
  my ($fh)=@_;
  return $fh && $fh->close();
}

sub read {
  my ($fd,$fs)=@_;
  my $data = do{{ local $/; <$fd>}};
  unless (defined $data and length $data) {
    die "NTrEd Client returned no data\n";
  }
  my $fs_files = Storable::thaw(decode_base64($data));
  undef $data;
  my $restore = $fs_files->[0];
  if (ref($restore)) {
    my $api_version = $restore->[6];
    if ($api_version ne $Treex::PML::API_VERSION) {
      warn "Warning: the binary content obtained via Treex::PML::Backend::NTRED from ".$fs->filename." is a dump of structures created by possibly incompatible Treex::PML API version $api_version (the current Treex::PML API version is $Treex::PML::API_VERSION)\n";
    }
    $fs->changeFS($restore->[0]);
    $fs->changeTrees(@{$restore->[1]});
    $fs->changeTail(@{$restore->[2]});
    $fs->[13]=$restore->[3]; # metaData
    $fs->changePatterns(@{$restore->[4]});
    $fs->changeHint($restore->[5]);
    $fs->FS->renew_specials();
  }
}



sub write {
  my ($fh,$fsfile)=@_;
  my $dump= [$fsfile->FS,
	     $fsfile->treeList,
	     [$fsfile->tail],
	     $fsfile->[13], # metaData
	     [$fsfile->patterns],
	     $fsfile->hint,
	     $Treex::PML::API_VERSION
	     # CAUTION: when adding to this list, don't forget to do the same
	     # in btred DUMP request handler
	    ];
  eval {
    print $fh (encode_base64(Storable::nfreeze([$dump])));
    print $fh ("\n");
  };
}

1;
__END__