#!/usr/bin/env perl
# -*- cperl -*-
#
# $Id: btred 4575 2011-04-21 12:52:52Z stepanek $
#
# BTrEd
# Copyright 2000-2008 Petr Pajas, All rights reserved.
# This software is covered by GPL - The General Public Licence
# Full text of the GPL can be found at http://www.gnu.org/copyleft/gpl.html.
#
# This program allows you run macros written for Tred in batch mode.
#

package main;
use Carp;
use Getopt::Long;
use Pod::Usage;
use IO;
use IO::File;
use File::Glob qw(:glob);
use Cwd;
use strict;

my $optparser;
my $exit_code = 0;

BEGIN {

use 5.008;
use vars qw($quiet $Quiet $debug $carp $csts_xargs $strip_prefix $add_prefix
	    $strip_suffix $append_suffix $output_format $config_file
	    $initial_code $macro $code $start_context $all_trees
	    $all_nodes $no_all_trees $no_all_nodes $glob
	    $all_nonhidden_nodes $file_encoding $allow_no_trees
	    $term_encoding $save $safe_mode $csts_tree_attrs
	    $csts_tecto $preload $warn_only $validate_fs $allow_host
	    $start_server $help $usage $manpage $obey_locks
	    $NO_HOOKS $userlogin $reffiles_to_save
	    $libDir $macroFile $stdout $stderr @backends @ISA @EXPORT
	    $fileNo $tredDebug $keyboardDebug $hookDebug $macroDebug
	    @files $backend %bkmap $nosave @preload_modules $print_version
	    $VERSION $lib $extra_backends $file_list $list_options
	    $_ERR %optmap $no_secondary $include_macro $ioBackends
	    $locale_charset $host $allow_switch_context
	    @resource_paths @define_symbols $dump_macros
	    $strict $warnings $no_backups
	    $list_extensions $enable_extensions $disable_extensions
	    $host_port_file
	   );

## Passing -o args... -- to TredMacro
@TredMacro::ARGV=grep { /^-o$/.../^--$/ } @ARGV;
shift @TredMacro::ARGV; pop @TredMacro::ARGV;
@ARGV=grep { not(/^-o$/.../^--$/) } @ARGV;

$optparser=new Getopt::Long::Parser(config => ["bundling"]);
%optmap =  (
	    "quiet|q" => \$quiet,
	    "very-quiet|Q" => \$Quiet,
	    "debugging|D" => \$debug,
	    "carp" => \$carp,
	    "fs2csts-attributes|x=s" => \$csts_xargs,
	    "filelist|l=s" => \$file_list,
	    "glob|g" => \$glob,
	    "strip-prefix|p=s" => \$strip_prefix,
	    "add-prefix|r=s" => \$add_prefix,
	    "strip-suffix|s=s" => \$strip_suffix,
	    "add-suffix|a=s" => \$append_suffix,
	    "output-format|f=s" => \$output_format,
	    "config-file|c=s" => \$config_file,
	    'option|O=s@' => \$TrEd::Config::override_options,
	    "initial-code|i=s" => \$initial_code,
	    "macro-file|m=s" => \$macro,
	    "include-macro-file|I=s" => \$include_macro,
	    "execute|e=s"    => \$code,
	    "context|t=s" => \$start_context,
	    "all-trees|T"    => \$all_trees,
	    "no-all-trees"    => \$no_all_trees,
	    "all-nodes|N"    => \$all_nodes,
	    "no-all-nodes"    => \$no_all_nodes,
	    "all-nonhidden-nodes|H"  => \$all_nonhidden_nodes,
	    "file-encoding|n=s" => \$file_encoding,
	    "terminal-encoding|d=s" => \$term_encoding,
	    "save|S" => \$save,
	    "knit|K=s" => \$reffiles_to_save,
	    "no-save" => \$nosave,
	    "safe-mode|F" => \$safe_mode,
	    "obey-locks" => \$obey_locks,
	    "no-secondary-files|Y" => \$no_secondary,
	    "csts-tree-attributes|X=s" => \$csts_tree_attrs,
	    "tectogrammatical-trees|R" => \$csts_tecto,
	    "preload-files|P" => \$preload,
	    "warn-only|W" => \$warn_only,
	    "validate-fs|V" => \$validate_fs,
	    "allow-host|b=s" => \$allow_host,
	    "server-host=s" => \$host,
	    "server-port|L=s"  => \$start_server,
	    "print-host-port=s"  => \$host_port_file,
	    "enable-extensions|j=s" => \$enable_extensions,
	    "disable-extensions|J=s" => \$disable_extensions,
	    "list-extensions" => \$list_extensions,
	    "help|h" => \$help,
	    "list-options" => \$list_options,
	    "usage|u"        => \$usage,
	    "man"            => \$manpage,
	    "lib"            => \$lib,
	    "preload-module|M=s" => \@preload_modules,
	    "extra-backends|B=s" => \$extra_backends,
	    "resource-dir|Z=s" => \@resource_paths,
	    "define-symbol|y=s" => \@define_symbols,
	    "allow-no-trees|0" => \$allow_no_trees,
	    "allow-switch-context" => \$allow_switch_context,
	    "dump-macros" => \$dump_macros,
	    "strict" => \$strict,
	    "warnings" => \$warnings,
	    "version|v"        => \$print_version,
	    "no-backups" => \$no_backups,
	   );

$optparser->getoptions(%optmap) or $usage=1;

$SIG{__DIE__} = sub { confess(@_) } if $carp;

use constant {
  ERROR_MACRO          =>  1,
  ERROR_HOOK           =>  2,
  ERROR_LOAD           =>  4,
  ERROR_SAVE           =>  8,
  ERROR_SAVE_SECONDARY => 16,
};

($userlogin) = (getlogin() || ($^O ne 'MSWin32') && getpwuid($<) || 'unknown');
($userlogin =~ /\S/) || warn "Could not determine user\'s login name\n";

$quiet=1 if $Quiet;
$NO_HOOKS = 0;

unless (open $_ERR, ">&STDERR") {
  warn("Cannot dup STDERR: $!");
  $_ERR=\*STDERR;
}
sub _msg { $_ERR->print("BTRED: ",@_); }

$_ERR->autoflush(1);

# Help and usage
if ($usage) {
  pod2usage(-msg => 'btred - an off-line TrEd macro processor which applies macros on given files');
#  exit 0;
}
if ($help) {
  pod2usage(-exitstatus => 0, -verbose => 99, -sections => '.*');
}
if ($manpage) {
  pod2usage(-exitstatus => 0, -verbose => 2);
}
if ($list_options) {
  foreach my $o (keys %optmap) {
    $o=~s/=.$//;
    foreach my $oo (split /\|/,$o) {
      print sort ((length($oo)>1) ? "--$oo\n" : "-$oo\n");
    }
  }
  exit;
}


# Default values of $libDir used to search for macro-file (tred.mac)
# and default-macro file (tred.def) are specified here. They may be
# overriden by value of LibDir in tred resource file (tredrc or ~/.tredrc - see above).
# It is also used to find TrEd::Config.pm module.

use Cwd;
use FindBin;
my $rb = $FindBin::RealBin;
$rb=~s{/$}{};
if (exists $ENV{TREDHOME}) {
  $libDir=$ENV{TREDHOME};
} elsif (-d "$rb/tredlib") {
  $libDir="$rb/tredlib";
} elsif (-d "$rb/../lib/tredlib") {
  $libDir="$rb/../lib/tredlib";
} elsif (-d "$rb/../lib/tred") {
  $libDir="$rb/../lib/tred";
}
_msg("Trying $libDir\n") if ($libDir and !$quiet);

$macroFile=undef;


# We *must* at least find TrEd::Config module to learn the correct libDir!!.
if (-d $libDir) {
  unshift @INC,$libDir;
}

{
  require TrEd::Version;
  import TrEd::Version;
  $VERSION = TRED_VERSION();
  if ($print_version) {
    print "BTrEd $VERSION\nPerl: $]\nPlatform: $^O\n";
    exit;
  }
}

{
  # in Windows, if HOME not defined, use user's AppData folder instaed
  require TrEd::Utils;
  import TrEd::Utils qw(:all);
  find_win_home();

  eval {
    setFHEncoding($_ERR,':utf8',"_ERR");
    setFHEncoding(\*STDERR,$term_encoding,"STDERR");
    setFHEncoding(\*STDOUT,$term_encoding,"STDOUT");
  };

  my $ld=$libDir;
  require TrEd::Config;
  import TrEd::Config;
  import TrEd::Config qw(&read_config &set_default_config_file_search_list $defaultMacroFile $macroDebug $hookDebug);
  $libDir=$ld;
}

$TrEd::Config::quiet=$quiet;

if (defined $config_file) {
  @TrEd::Config::config_file_search_list=($config_file); 
  # override any other possible config files
} else {
  set_default_config_file_search_list();
}

if ($quiet) {
  $tredDebug=$keyboardDebug=$hookDebug=$macroDebug=0;
} elsif ($debug) {
  $Treex::PML::IO::Debug=$tredDebug=$keyboardDebug=$hookDebug=$macroDebug=1;
}

read_config();
{
  unless (-d $libDir) {
    print <<'EOL';
 BTrEd could not find a tredlib directory. You may need to point
 to its location by the TREDHOME variable or add a correct LibDir
 field to your ~/.tredrc.

EOL
    die "Error: Could not find lib-directory.";
  }
  if ($lib) {
    print $libDir,"\n";
    exit;
  }

  unshift @INC,$libDir unless (grep($_ eq $libDir, @INC));
  my $libs = File::Spec->catfile($libDir,'libs');
  if (-d $libs) {
    push @INC, glob(File::Spec->catfile($libs,'*',''));
  }
}

$macroFile="$libDir/tred.mac" unless (defined $macroFile);
if (defined $macro) {
  $macroFile=$macro;
}
####################################

use Benchmark;


require Treex::PML;
import Treex::PML;
import Treex::PML qw(&Index &ImportBackends);
$Treex::PML::Debug=1 if $debug;
$Treex::PML::resourcePath=join($Treex::PML::resourcePathSplit,
			  map { length($_) ? $_ : $Treex::PML::resourcePath }
			  map { split($Treex::PML::resourcePathSplit,$_,-1) }
			    @resource_paths) if @resource_paths;

# require Fslib; # compatibility

_msg("Resource path: $Treex::PML::resourcePath\n") unless $quiet;

# import min and max functions
require TrEd::MinMax;
import TrEd::MinMax;

# import encode and decode functions
require TrEd::Convert;
import TrEd::Convert;

# import read_macros etc.
require TrEd::Macros;
import TrEd::Macros;

$TrEd::Macros::strict = $strict;
$TrEd::Macros::warnings = $warnings;

require TrEd::Extensions;
import TrEd::Extensions qw(:all);

# basic tree operations
require TrEd::Basics;
import TrEd::Basics;

#load back-ends
@backends=('FS',ImportBackends(
  split(/,/,$extra_backends),
  split(/,/,$ioBackends),
  qw(NTRED Storable PML CSTS TrXML TEIXML PMLTransform)));


# these are for macros
$stdout=\*STDOUT;
$stderr=\*STDERR;

use Exporter;
@ISA=qw(Exporter);
# This is default export to macros
@EXPORT = qw($libDir &min &max $stdout $stderr);

# it seems, that under Windoze setting LC_NUMERIC back to us does not
# work, so I recommend not to use czech locales there, unless you
# really want the decimal points to be replaced by commas in
# postscript:)
eval {
  ($TrEd::Config::useLocales) && do {
    use locale;
    use POSIX qw(locale_h);
    $ENV{LC_ALL}=undef;
    setlocale(LC_ALL,undef);
    setlocale(LC_NUMERIC,"C");
  };

  if ($TrEd::Config::useCzechLocales) {
    no strict;
    use locale;
    use POSIX qw(locale_h);
    setlocale(LC_COLLATE,"cs_CZ");
    setlocale(LC_NUMERIC,"C");
    setlocale(LANG,"cs_CZ");
  }
  setlocale(LC_MESSAGES,"C");
};
warn $@ if $@;

if ($]>=5.008) {
  eval {
    require I18N::Langinfo;
    $locale_charset = I18N::Langinfo::langinfo(I18N::Langinfo::CODESET());
  };
}
require Encode;

} # BEGIN


my $safe=$safe_mode; # so that it cannot be changed from outside

sub conv_from_locale {
  my ($str)=@_;
  if ($locale_charset and $TrEd::Convert::support_unicode) {
    return Encode::decode($locale_charset,$str);
  } else {
    return $str;
  }
}

# These are used only in macros and hooks!!!
TrEd::Macros::define_symbol('BTRED');
for my $sym1 (@define_symbols) {
  for my $sym (split /,/, $sym1) {
    if ($sym=~/=/) {
      TrEd::Macros::define_symbol(split(/=/,$sym,2));
    } else {
      TrEd::Macros::define_symbol($sym);
    }
  }
}

set_macro_variable(root => undef,
		   this => undef,
		   FileNotSaved => 0,
		   forceFileSaved => 0,
		   # for compatibility with Graph2Tred
		   _NoSuchTree => 0,
		   NodeClipboard => undef
		  );

$fileNo=0;

#$TrEd::Basics::on_tree_change= \&updateTredMacroGlobals;
#$TrEd::Basics::on_node_change= \&updateTredMacroGlobals;
#$TrEd::Basics::on_current_change= \&updateTredMacroGlobals;

if ($list_extensions) {
  prepareExtensions({list_to=>\*STDOUT});
  exit;
} else {
  loadMacros();
}

if ($dump_macros) {
  binmode STDOUT,":utf8";
  use Data::Dumper;
  print "BEGIN {\n";
  print Data::Dumper->new([$libDir],['main::libDir'])->Dump;
  print "}\n";
  print @TrEd::Macros::macros;
  exit;
}

_msg("done.\n") unless $quiet;

if ($file_list) {
  my $fh;
  foreach my $l (split /\s*,\s*/,$file_list) {
    print STDERR "Reading -l filelist $l...\n" if $tredDebug;
    if ($l eq '-') {
      $fh=\*STDIN;
    } else {
      open($fh,'<',$l) or do {
	print STDERR "Warning: Cannot open filelist $l: $!\n";
	next;
      };
    }
    @files=<$fh>;
    chomp @files;
    shift @files if ($l=~/\.fl$/i and $files[0]!~m{[/.]} and ! -f Treex::PML::ResolvePath($l,$files[0]));
    if ($l=~/\.fl$/i) {
	# make realtive filenames absolute relative to the .fl file
      @files=map { Treex::PML::ResolvePath($l,$_) } @files;
    }
    close($fh) unless $fh==\*STDIN; # we don't close STDIN to avoid problems 
    # with open2 due to unresolved bug in perl: 
    # http://rt.perl.org/rt3/Public/Bug/Display.html?id=37033
    # If this turns out to be a problem, using eval('close($fh)') should work as well.
  }

}


if ($glob or $^O eq 'MSWin32') {
  my $s;
  push @files,map glob, map { $s=$_; $s=~s{ }{\\ }g; $s }  @ARGV;
} else {
  push @files,@ARGV;
}
s/\s+$// for @files;

@ARGV=@TredMacro::ARGV;



%bkmap=(
	fs => 'FS',
	csts => 'CSTS',
	trxml => 'TrXML',
	tei => 'TEIXML',
	storable => 'Storable'
       );

$Treex::PML::Backend::FS::CheckListValidity=$validate_fs;

$csts_tecto && Csts2fs::setupTR();
if ($csts_tree_attrs ne "") {
  Csts2fs::setupSpec(split ',',$csts_tree_attrs,-1);
  Fs2csts::setupSpec(split ',',$csts_tree_attrs,-1);
}

@Fs2csts::extra_attributes=split /,/,$csts_xargs;

if ($output_format) {
  my $format=$output_format ? lc($output_format) : "";
  unless ( $backend=$bkmap{$format} ) {
    die "Unknown format $format. Use -f [".join("|",sort keys %bkmap)."]\n";
  }
}

$TrEd::Convert::inputenc=$file_encoding if $file_encoding;

foreach my $module (@preload_modules) {
  eval "require $module";
  die $@ if $@;
}

startMain();
exit $exit_code;

############################
############################
############################

sub _set_encoding {
  my ($fh,$enc,$what)=@_;
  eval {
    _msg("forcing encoding $enc for $what\n") if $debug;
    setFHEncoding(@_);
  };
  _msg($@) if $@;
}
sub _make_uniq ($) { my %U; @{$_[0]} = grep {!exists($U{$_}) && ($U{$_}=1)} @{$_[0]} }
sub sign_md5 ($$) {
  my ($key,$message)=@_;
  Encode::_utf8_off($key);
  Encode::_utf8_off($message);
  TrEd::Cipher::block_md5(TrEd::Cipher::block_xor($key,$message));
}
sub _benchmark () {
  my $number_of_iters=10000;
  my $i;
  my %a;
  my $benchmark_code='$a{$i++}=(join("",map uc,split "(..)","afa${i}sd ${i}fsd1f2 asf${i}1sdfdsf fsasf")=~/\s+\d+/);';
  (timestr timeit ($number_of_iters,$benchmark_code))=~/(\S+) CPU/;
#  return 200;
  return $1*1000; # miliseconds
}
sub _threads () { 1 };

sub _end_response {
  my ($control,$client)=@_;
  $client->print("$control END_OF_SERVER_RESPONSE\n");
}

sub _copy_output {
  my ($macro_stdout,$hub)=@_;
  $macro_stdout->flush();
  seek($macro_stdout,0,0);
  _set_encoding($hub,$term_encoding,"socket to hub");
  $hub->autoflush(0);
  my $l;
  while (!eof($macro_stdout)) {
    $l=<$macro_stdout>;
    $hub->print($l);
  }
  $hub->print("\n") if $l ne "" and !chomp($l);
  $hub->flush();
  $hub->autoflush(1);
}

sub _revert_redirect_stdout {
  my ($old)=@_;
  open $old, ">&STDOUT" or warn "Cannot dup STDOUT: $!";
}

sub _revert_redirect_stderr {
  my ($old)=@_;
  open $old, ">&STDERR" or warn "Cannot dup STDERR: $!";
}

sub _redirect_stdout {
  my ($new_out)=@_;
  local *MOUT=*$new_out;
  my $old;
  open $old, ">&STDOUT" or warn "Cannot dup STDOUT: $!";
  open(STDOUT, "+>&MOUT") or warn "Cannot redirect STDOUT: $!";
#  $new_out->autoflush(1);
  return $old;
}

sub _redirect_stderr {
  my ($new_out)=@_;
  local *MOUT=*$new_out;
  my $old;
  open $old, ">&STDERR" or warn "Cannot dup STDERR: $!";
  open(STDERR, "+>&MOUT") or warn "Cannot redirect STDERR: $!";
  $new_out->autoflush(1);
  return $old;
}

sub startMain {
  my $grp={
	   treeNo => 0,
	   FSFile => undef,
	   macroContext =>  defined($start_context) ? $start_context : 'TredMacro',
	   currentNode => undef,
	   root => undef
	  };
  my $filecount=@files;
  #  eval (join("",@macros)."\n return 1;");
  my $context = $grp->{macroContext};

  $TrEd::Macros::on_error = sub { _msg($_[1]) };

  if ($start_server) {
    $SIG{USR1} = sub { };
    # ----------------------------------------
    # SERVER MODE
    # ----------------------------------------
    require IO::Socket::INET;
    require TrEd::Cipher;
    # Start btred server
    preloadFiles($grp,\@files);

    my $control='@-NTRED-@-PROTOCOL-@'; # @@@ marks the beginning of control lines

    my $key = readline(*STDIN);
#    close STDIN;
    if ($key =~ /^\Q$control\E SESSION-KEY=([0-9A-Z]+)$/) {
      $key = TrEd::Cipher::hex_to_block($1);
      /(.)/; # clean-up :-)
    } else {
      die "Was expecting the session key!\n";
    }

    my $port=$start_server;
    my $max_port = ($port =~ s/-([0-9]+)$// ? $1 : undef);
    use Sys::Hostname;
    chomp ($host=hostname()) unless defined $host; #$ENV{HOSTNAME};
    my $server;
    while (1) {
      $server = new IO::Socket::INET (LocalHost => $host,
				      LocalPort => $port,
				      Proto => 'tcp',
				      Listen => 5,
				      Reuse => 1,
				     );
      last if $server or !defined($max_port) or $port>=$max_port;
      $port++;
    }
    die "Cannot open socket at $host:$port: $!\n" unless $server;


    if ($host_port_file) {
      open my $fh, '>', $host_port_file;
      print $fh "HOST=$host PORT=$port\n";
      close $fh;
    }

    _msg("Waiting for hub on $host:$port\n");



    $allow_host=~s/\s//g;
    # resolve peer IP
    if ($allow_host) {
      ($allow_host) = (`LC_ALL=C host "$allow_host"` =~ / has address (.*)$/) if ($allow_host =~/[^:.0-9]/);
      _msg("Awaiting connection from $allow_host\n");
    }
    my ($hub,$peer);
    do {{
      $hub = $server->accept();
      $peer=$hub->peerhost();
      if ($hub and $allow_host and $peer ne $allow_host) {
	_msg("Denying connection to peer $peer!\n");
	$hub->close();
	undef $hub;
      } elsif ($hub and TrEd::Cipher::Authentify($key,$hub,$control)!=1) {
	$hub->close();
	undef $hub;
      }
    }} while (!$hub);
    _msg("Connection to the hub on $peer established.\n");
    my $request_no=0;
    _msg("Waiting for a request from the hub...\n\n");
    $hub->autoflush(1);
    while (1) {
      _set_encoding($hub,':utf8',"socket to hub");
      my $state='default';
      my $request;
      my %request;
      my $server_no = undef;
      # --- reading request from hub ---
      while (<$hub>) {
        if (/^\Q$control\E SERVER_NO=([0-9]+)/) {
	  $server_no = $1;
        } elsif (/^\Q$control\E REQUEST_TYPE=(.*)/) {
	  $request_no++;
	  _msg("Receiving request $request_no: $1\n");
	  %request = (); # clear
	  $request{REQUEST_TYPE}=$1;
	  $request="";
	} elsif (/^\Q$control\E MD5_SIGNATURE (.*)$/) {
	  $request{SIGNATURE} = $1;
        } elsif (/^\Q$control\E STATE=(.*)/) {
	  $state=$1;
	  $request.=$_;
	  $request{"STATE_".$state}.="";
	  if ($state eq 'FSFile' and $request{REQUEST_TYPE} eq 'UPLOAD') {
	    _set_encoding($hub,undef,"socket to hub");
	  }
        } elsif (!/^\Q$control\E/) {
	  $request.=$_;
	  $request{"STATE_".$state}.=$_;
        } elsif (/\Q$control\E END_OF_REQUEST/) {
          $state='END_OF_REQUEST';
	  last
        }
      }
      for (qw(ENCODING Strip-suffix Strip-prefix Prefix Suffix REGEXP_FILES)) {
	if (exists $request{"STATE_".$_}) {
	  $request{"STATE_".$_} =~ s/[\n\r]+$//;
	}
      }
      ($state eq 'END_OF_REQUEST') || die "Broken request '$request{REQUEST_TYPE}'!\n";
      _msg "Request received from the hub: $request{REQUEST_TYPE}\n";

      _msg("Verifying request signature...\n");
      if ($request{SIGNATURE} ne sign_md5($key,$request)) {
	$hub->print("$control SERVER_RESPONSE_STDERR\n");
	$hub->print("UNAUTHORIZED REQUEST: MD5 SIGNATURE FAILED\n");
	$hub->print("Signatures:\n$request{SIGNATURE}\n".sign_md5($key,$request)."\n");
	_end_response($control,$hub);
      } else {
	# --- performing the request on the trees ----
	_msg("Performing the hub request...\n");
	$NO_HOOKS=1;
	if ($request{REQUEST_TYPE} eq 'LOAD_FILES') {
	  local $no_secondary = $request{STATE_NO_SECONDARY} ? 1 : $no_secondary;
	  local $allow_no_trees = $request{STATE_ALLOW_NO_TREES} ? 1: $allow_no_trees;

	  my @new=split /\n/,$request{STATE_FILELIST};
	  push @files,@new;

	  eval {
	    preloadFiles($grp,\@new,$hub);
	    die $@ if $@ ;
	  };
	  if ($@) {
	    $hub->print("$@\n");
	  } else {
	    $hub->print("OK\n");
	  }
	  _end_response($control,$hub);
	} elsif ($request{REQUEST_TYPE} eq 'BENCHMARK') {
	  $hub->print(_benchmark(),",",_threads(),"\n"); # benchmark,threads
	  _end_response($control,$hub);
	} elsif ($request{REQUEST_TYPE} eq 'EVAL_CODE') {
	  $NO_HOOKS=0;
	  _msg("Initializing safe compartment...\n") if $safe;

	  # create temporary file to store macro output
	  my $macro_stdout = IO::File->new_tmpfile();
	  my $macro_stderr = IO::File->new_tmpfile();

	  my $old_stdout = _redirect_stdout($macro_stdout);
	  my $old_stderr = _redirect_stderr($macro_stderr);

	  local $term_encoding=$request{STATE_ENCODING} if ($request{STATE_ENCODING});
	  local $strip_prefix=$request{"STATE_Strip-prefix"} if exists $request{"STATE_Strip-prefix"};
	  local $strip_suffix=$request{"STATE_Strip-suffix"} if exists $request{"STATE_Strip-suffix"};
	  local $add_prefix=$request{"STATE_Prefix"} if exists $request{"STATE_Prefix"};
	  local $append_suffix=$request{"STATE_Suffix"} if exists $request{"STATE_Suffix"};

	  _set_encoding(\*STDOUT,$term_encoding);
	  _set_encoding(\*STDERR,$term_encoding);


	  # initialize Safe compartment

	  init_tredmacro($grp);

	  # script command-line arguments
	  if (exists($request{STATE_ARGS})) {
	    no strict qw(refs);
	    @{macro_variable('ARGV')}=split "\n",$request{STATE_ARGS};
	    @{macro_variable('::ARGV')}=@{macro_variable('ARGV')};
	  } else {
	    no strict qw(refs);
	    @{macro_variable('ARGV')}=();
	    @{macro_variable('::ARGV')}=();
	  }

	  #STDOUT->autoflush(1);
	  # load macro
	  _msg "COMPILING MACRO\n";
	  chomp($request{STATE_CONTEXT});
	  $context=$request{STATE_CONTEXT} || 'TredMacro';
	  $context='TredMacro' if $context eq 'main';
	  $SIG{USR1} = sub { die "BTRED: $host: User break!\n" };
	  $grp->{macroContext} = $context;

	  set_macro_variable('NTRED_SERVER_NO' => $server_no);
	  doEvalMacro($grp,"package $context;\n"."#line 1 \"$request{REQUEST_TYPE}\"\n".$request{STATE_MACRO});

	  # execute hooks and the code of the query

	  $hub->print("$control SERVER_RESPONSE_STDERR\n");
	  $hub->print("$@\n") if $@;
	  if (!$@ and keys(%{$grp->{preloaded}})) {
	    my $stop = doEvalHook($grp,"start_hook");
	    $stop = doEvalHook($grp,"preload_hook") if (!$@ and $stop ne 'stop');
	    $hub->print("$@\n") if $@;
	    if (!$@ and $stop ne 'stop') {
	      _msg "RUNNING CODE: $request{STATE_CODE}\n";
	      my $status = gotoFile($grp,0, -hook_can_stop => 1);
	      my $t0 = new Benchmark;
	      my $regexp = $request{STATE_REGEXP_FILES};
	      if (exists $request{STATE_FILELIST}) {
		my @fl = grep { !defined($regexp) or $_=~$regexp } split /\n/,$request{STATE_FILELIST};
		foreach my $file (@fl) {
		  # normalize urls
		  my $goto;
		  $goto=$1 if $file=~s/(##?[0-9A-Z]+(?:\.[0-9]+)?)$//;
		  if (exists $grp->{preloaded}{$file}) {
		    $status = openFile($grp,$file.$goto, -hook_can_stop => 1);
		    last if $@;
		    if ($status) {
		      doEvalMacro($grp,"package $context;".$request{STATE_CODE});
		      last if $@;
		    }
		  }
		}
	      } else {
		unless ($status>0) {
		  $status = nextFileSkipBad($grp,-hook_can_stop => 1) 
		}
		if ($status>0) {
		  do {{
		    if (!defined($regexp) or 
			$grp->{FSFile} and $grp->{FSFile}->filename =~ $regexp) {
		      doEvalMacro($grp,"package $context;".$request{STATE_CODE});
		    }
		  }} while (!$@ and 
			      nextFileSkipBad($grp, -hook_can_stop => 1) 
				and !$@);
		}
	      }
	      $hub->print("$@\n") if $@;
	      _msg($@) if $@; undef $@;
	      closeFile($grp);
	      $hub->print("$@\n") if $@;
	      _msg($@) if $@; undef $@;
	      doEvalHook($grp,"exit_hook");
	      $hub->print("$@\n") if $@;
	      _msg($@) if $@;undef $@;
	      my $t1 = new Benchmark;
	      my $time = timediff($t1, $t0) if ($t1 and $t0);
	      $hub->print("BTRED: $host: Total Time: ",timestr($time),"\n") if $time ne "" and not $request{STATE_QUIET};
	      _msg("Total Time: ",timestr($time),"\n");
	    }
	  }
	  $SIG{USR1} = sub { };
	  $hub->print("No files to process at btred server $host:$port\n") if (!keys(%{$grp->{preloaded}}));
	  cleanup_tredmacro($grp,split(/\n/,"package $context;\n".$request{STATE_MACRO}."\n".$request{STATE_CODE}));
	  # send macro's error output from tmp file to client
	  _revert_redirect_stderr($old_stderr);
	  _set_encoding($macro_stderr,$term_encoding);
	  _copy_output($macro_stderr,$hub);
	  $macro_stderr->close;

	  $hub->print("$control SERVER_RESPONSE_STDOUT\n");

	  # send macro's output from tmp file to client
	  _revert_redirect_stdout($old_stdout);
	  _set_encoding($macro_stdout,$term_encoding);
	  _copy_output($macro_stdout,$hub);
	  $macro_stdout->close;

	  _end_response($control,$hub);
	  _msg("The processing of request $request_no completely finished.\n");
	} elsif ($request{REQUEST_TYPE} eq 'QUIT') {
	  _msg "Quitting on client's request\n";
	  $hub->print("OK\n");
	  _end_response($control,$hub);
	  exit 0;
	} elsif ($request{REQUEST_TYPE} eq 'RELOAD') {
	  local $no_secondary = $request{STATE_NO_SECONDARY} ? 1 : $no_secondary;
	  local $allow_no_trees = $request{STATE_ALLOW_NO_TREES} ? 1: $allow_no_trees;
	  my $regexp = $request{STATE_REGEXP_FILES};
	  if (exists $request{STATE_FILELIST}) {
	    _msg "Reloading files at client's request\n";
	    my @fl = grep { (!defined($regexp) or $_=~$regexp) and ref($grp->{preloaded}->{$_}) } split /\n/,$request{STATE_FILELIST};
	    foreach my $file (@fl) {
	      closePreloadedFile($grp,$file);
	    }
	    eval {
	      preloadFiles($grp,\@fl,$hub);
	      die $@ if $@ ;
	    };
	  } elsif (defined($regexp)) {
	    _msg "Reloading files matching /$regexp/ at client's request\n";
	    my @fl = grep { (!defined($regexp) or $_=~$regexp) and ref($grp->{preloaded}->{$_}) } keys %{$grp->{preloaded}};
	    foreach my $file (@fl) {
	      closePreloadedFile($grp,$file);
	    }
	    eval {
	      preloadFiles($grp,\@fl,$hub);
	      die $@ if $@ ;
	    };
	  } else {
	    _msg "Reloading all open files at client's request\n";
	    closeAllPreloaded($grp);
	    eval {
	      preloadFiles($grp,\@files,$hub);
	      die $@ if $@ ;
	    };
	  }
	  if ($@) {
	    $hub->print("$@\n");
	  } else {
	    $hub->print("OK\n");
	  }
	  _end_response($control,$hub);
	} elsif ($request{REQUEST_TYPE} eq 'RELOAD_CHANGED') {
	  local $no_secondary = $request{STATE_NO_SECONDARY} ? 1 : $no_secondary;
	  local $allow_no_trees = $request{STATE_ALLOW_NO_TREES} ? 1: $allow_no_trees;
	  _msg "Reloading changed files at client's request\n";
	  my @changed = grep { ref($grp->{preloaded}->{$_}) and
				 fileOrSecondariesNotSaved($grp,$grp->{preloaded}->{$_})
			       } @files;
	  foreach my $file (@changed) {
	    closePreloadedFile($grp,$file);
	  }
	  eval {
	    preloadFiles($grp,\@changed,$hub);
	    die $@ if $@;
	  };
	  if ($@) {
	    $hub->print("$@\n");
	  } else {
	    $hub->print("OK\n");
	  }
	  _end_response($control,$hub);
	} elsif ($request{REQUEST_TYPE} eq 'RELOAD_MACROS') {
	  my ($f,$d,$e)= map $request{$_}, qw(STATE_Filename STATE_DISABLE_EXTENSIONS STATE_ENABLE_EXTENSIONS);
	  defined && s/[\n\r]+$// for ($f,$d,$e);
	  # chomp $f;
	  $macroFile = $f if $f;
	  $enable_extensions = $e;
	  $disable_extensions = $d;
	  _msg "Reloading macros from $macroFile libdir=$libDir at client's request\n";
	  %TrEd::Macros::defines=(BTRED => 1); # reset defines
	  eval {
	    loadMacros();
	  };
#	  _msg(@TrEd::Macros::macros);
	  if ($@) {
	    $hub->print("$@\n");
	  } else {
	    $hub->print("OK\n");
	  }
	  _end_response($control,$hub);
	} elsif ($request{REQUEST_TYPE} eq 'COUNT') {
	  _msg "Counting all open files at client's request\n";
	  $hub->print("$control SERVER_RESPONSE_STDOUT\n");
	  $hub->print("$host:$port has ",scalar(@files)," files\n");
	  _end_response($control,$hub);
	} elsif ($request{REQUEST_TYPE} eq 'LIST_EXTENSIONS') {
	  _msg "Listing extensions on client's request\n";
	  $hub->print("$control SERVER_RESPONSE_STDOUT\n");
	  prepareExtensions({list_to=>$hub});
	  _end_response($control,$hub);
	} elsif ($request{REQUEST_TYPE} eq 'LIST') {
	  local $no_secondary = $request{STATE_NO_SECONDARY} ? 1 : $no_secondary;
	  _msg "Listing all open files at client's request\n";
	  $hub->print("$control SERVER_RESPONSE_STDOUT\n");
	  my $regexp = $request{STATE_REGEXP_FILES};
	  if (exists $request{STATE_FILELIST}) {
	    my @f = grep { (!defined($regexp) or $_=~$regexp) and ref($grp->{preloaded}->{$_}) } split /\n/,$request{STATE_FILELIST};
	    $hub->print(join("\n",@f),"\n") if @f;
	  } else {
	    my @f = grep { !defined($regexp) or $_=~$regexp } @files;
	    $hub->print(join("\n",@f),"\n") if @f;
	  }
	  _end_response($control,$hub);
	} elsif ($request{REQUEST_TYPE} eq 'LIST_SECONDARY') {
	  _msg "Listing secondary files at client's request\n";
	  $hub->print("$control SERVER_RESPONSE_STDOUT\n");
	  if (ref($grp->{secondary})) { 
	    my $regexp = $request{STATE_REGEXP_FILES};
	    if (exists $request{STATE_FILELIST}) {
	      my @f = grep { $_=~$regexp and ref($grp->{secondary}->{$_}) } split /\n/,$request{STATE_FILELIST};
	      $hub->print(join("\n",@f),"\n") if @f;
	    } else {
	      my @f = sort grep { !defined($regexp) or $_=~$regexp } keys %{$grp->{secondary}};
	      $hub->print(join("\n",@f),"\n") if @f;
	    }
	  }
	  _end_response($control,$hub);
	} elsif ($request{REQUEST_TYPE} eq 'LIST_CHANGED') {
	  local $no_secondary = $request{STATE_NO_SECONDARY} ? 1 : $no_secondary;
	  _msg "Listing all open files at client's request\n";
	  $hub->print("$control SERVER_RESPONSE_STDOUT\n");
	  $hub->print(map { $_."\n"} grep { ref($grp->{preloaded}->{$_}) and
					    fileOrSecondariesNotSaved($grp,$grp->{preloaded}->{$_})
				       } @files);
	  _end_response($control,$hub);
	} elsif ($request{REQUEST_TYPE} eq 'DUMP') {
	  $hub->print("$control SERVER_RESPONSE_STDOUT\n");
	  _msg "Dump request for $request{STATE_default}\n";

# 	  if ($request{STATE_format} =~ /^Data::Dumper\s*/) {
# 	    use Data::Dumper;
# 	    my @dump;
# 	    foreach my $f (grep /\S/,split /\n/,$request{STATE_default}) {
# 	      next unless ($f);
# 	      $f=~s{^ntred://}{};
# 	      $f=~s{@(\d+)##1(\.\d+)?\s*$}{##$1$2};
# 	      next unless openFile($grp,$f,-justpreloaded => 1,
# 				   -secondary => !$no_secondary);
# 	      _msg "Dumping the tree $f at client's request\n";
# 	      my $fsfile = $grp->{FSFile};
# 	      push @dump, [$fsfile->FS,
# 			   $f=_has_suffix($f) ? [$grp->{root}] : $fsfile->treeList,
# 			   [$fsfile->tail],
# 			   $fsfile->[13],
# 			   [$fsfile->patterns],
# 			   $fsfile->hint];
# 	    }
# 	    $hub->print(Data::Dumper->new([\@dump],
# 					  ['dump']
# 					 )->Indent(0)->Purity(1)->Dump);
# 	    $hub->print("\n");
# 	  } elsif ($request{STATE_format} =~ /^Storable-Base64\s*/) {
	    use Storable;
	    use MIME::Base64;
	    my @dump;
 	    my @save_req;
	    foreach my $f (grep /\S/,split /\n/,$request{STATE_default}) {
	      next unless ($f);
	      chomp($f);
	      $f=~s{^ntred://}{};
	      $f=~s{@(\d+)##1(\.\d+)?\s*$}{##$1$2};
	      next unless openFile($grp,$f,-justpreloaded => 1, -secondary => !$no_secondary);
	      my $fsfile = $grp->{FSFile};
	      next unless ref($fsfile);
	      _msg "Dumping the tree $f at client's request ($fsfile)\n";
	      my $req = $fsfile->metaData('fs-require');
	      if (ref($req)) {
		push @save_req,[$fsfile,$req];
		if ($no_secondary) {
		  $fsfile->changeMetaData('fs-require',undef);
		} else {
		  $fsfile->changeMetaData('fs-require',[ map {
		    [ $_->[0], "ntred://".Treex::PML::ResolvePath($fsfile->filename,$_->[1]) ] } @$req ]);
		}
	      }
	      push @dump, [$fsfile->FS,
			   $f=_has_suffix($f) ? [$grp->{root}] : $fsfile->treeList,
			   [$fsfile->tail],
			   $fsfile->[13],
			   [$fsfile->patterns],
			   $fsfile->hint,
			   $Treex::PML::API_VERSION
			  ];
	    }
	    if (@dump) {
	      eval {
		$hub->print(encode_base64(Storable::nfreeze(\@dump)));
	      };
	      $hub->print("\n");
	      if ($@) {
		$hub->print("$control SERVER_RESPONSE_STDERR\n");
		$hub->print("$@\n");
	      }
	    }
	  foreach my $saved (@save_req) {
	    $saved->[0]->changeMetaData('fs-require',$saved->[1]);
	  }
	  _end_response($control,$hub);
	} elsif ($request{REQUEST_TYPE} eq 'UPLOAD') {
	  $hub->print("$control SERVER_RESPONSE_STDOUT\n");
	  my $f=$request{STATE_Filename};
	  # chomp $f;
	  $f =~ s/[\n\r]+$//;
	  _msg "Uploading $f at client's request\n";
	  $f=~s{^ntred://}{};
	  $f=~s{@(\d+)##1(\.\d+)?\s*$}{##$1$2};
	  if ($] >= 5.008) {
	    require Encode;
	    $request{STATE_FSFile} = Encode::decode($TrEd::Convert::inputenc,$request{STATE_FSFile});
	  }
	  if ($f and openFile($grp,$f,-justpreloaded => 1,-secondary => 1) and ref($grp->{FSFile})) {
	    _msg "Uploading $f at client's request\n";

	    my $fs_files = Storable::thaw(decode_base64($request{STATE_FSFile}));
	    my $restore = ref($fs_files) ? $fs_files->[0] : undef;
	    if (ref($restore)) {
	      my $fs = $grp->{FSFile};
	      $fs->changeFS($restore->[0]);
	      $fs->changeTail(@{$restore->[2]});
	      my $req = $fs->metaData('fs-require');
	      $fs->[13]=$restore->[3]; #metaData
	      $fs->changeMetaData('fs-require',$req);
	      $fs->changePatterns(@{$restore->[4]});
	      $fs->changeHint($restore->[5]);
	      $fs->FS->renew_specials();
	      # TODO: maybe clean $fs->appData->{'id-hash'}
	      if (_has_suffix($f)) {
		# change only one tree
		_msg "Update tree $grp->{treeNo} ($f)\n";

		# in this case, all other trees remain, but
		# since we chainged the schema, we must also change
		# their node-types....
		# we try to use type names in order to do that
		my $trees = $fs->treeList();
		my $prev = $trees->[$grp->{treeNo}];
		$prev->destroy() if ref($prev);
		my $schema = $fs->metaData('schema');
		if (ref($schema)) {
		  # file uses a schema!
		  my %types;
		  foreach my $type ($schema->node_types) {
		    $types{$type->get_decl_path} = $type if ref($type);
		  }
		  if (keys(%types)) {
		    for (my $i=0; $i<@{$trees}; $i++) {
		      unless ($i == $grp->{treeNo}) {
			# for every node in the tree change its schema type
			my $node = $trees->[$i];
			while ($node) {
			  my $type = $node->type;
			  next unless $type;
			  my $path = $type->get_decl_path;
			  if (exists $types{$path}) {
			    $node->set_type($types{$path});
			  }
			} continue {
			  $node = $node->following;
			}
		      }
		    }
		  }
		}
		$trees->[$grp->{treeNo}]=$restore->[1]->[0];
	      } else {
		_msg "Updated whole file ($f)\n";
		# change the whole file
		$_->destroy for ($fs->trees);
		$fs->changeTrees(@{$restore->[1]});
	      }
	      $fs->notSaved(1);
	    } else {
	      _msg "read failed\n";
	    }
	    closeFile($grp);
	  }
	  _end_response($control,$hub);
	} elsif ($request{REQUEST_TYPE} eq 'SAVE' or
		   $request{REQUEST_TYPE} eq 'SAVE_CHANGED'
		  ) {
	  local $no_secondary = $request{STATE_NO_SECONDARY} ? 1 : $no_secondary;
	  for (qw(Format Strip-suffix Strip-prefix Prefix Suffix)) {
	    if (exists $request{"STATE_".$_}) {
	      $request{"STATE_".$_} =~ s/[\n\r]+$//;
	    }
	  }
	  # create temporary file to store std output
	  my $macro_stdout = IO::File->new_tmpfile();
	  my $old_stdout = _redirect_stdout($macro_stdout);
	  do {
	    local $backend=$bkmap{$request{STATE_Format}} if exists $request{STATE_Format};
	    local $strip_prefix=$request{"STATE_Strip-prefix"} if exists $request{"STATE_Strip-prefix"};
	    local $strip_suffix=$request{"STATE_Strip-suffix"} if exists $request{"STATE_Strip-suffix"};
	    local $add_prefix=$request{"STATE_Prefix"} if exists $request{"STATE_Prefix"};
	    local $append_suffix=$request{"STATE_Suffix"} if exists $request{"STATE_Suffix"};
	    local $reffiles_to_save=$request{"STATE_Knit"} if exists $request{"STATE_Knit"};

	    my %fl;
	    my $listed = 0;
	    if (exists $request{STATE_FILELIST}) {
	      $listed = 1;
	      %fl = map { $_ => 1 } grep { ref($grp->{preloaded}->{$_}) }
		split /\n/,$request{STATE_FILELIST};
	    }
	    my $regexp = $request{STATE_REGEXP_FILES};
	    eval {
	      gotoFile($grp,0);
	      die $@ if $@;
	      do {{
		my $fsfile = $grp->{FSFile};
		my $filename = $fsfile->filename;
		next unless ref($fsfile);
		if ((!defined($regexp) or $filename =~ $regexp) and 
		    (!$listed or $fl{ $filename })) {
		  if ($request{REQUEST_TYPE} eq 'SAVE' or $fsfile->notSaved()) {
		    my ($out,$error) = saveFile($grp);
		    if (!defined($error)) {
		      $macro_stdout->print("Saved ",$filename," as $out\n");
		    } else {
		      $macro_stdout->print("ERROR SAVING",$filename,": $error\n");
		    }
		  }
		  unless ($no_secondary) {
		    foreach my $secondary (secondaryDocumentsTo($grp,$fsfile)) {
		      if ($request{REQUEST_TYPE} eq 'SAVE' or $secondary->notSaved()) {
			# TODO: we should probably go recursion here...
			# (secondary files of secondary files...)
			my ($out,$error) = saveFile($grp,$secondary); 
			if (!defined($error)) {
			  $macro_stdout->print("Saved secondary file ",$secondary->filename," as $out\n");
			} else {
			  $macro_stdout->print("ERROR SAVING SECONDARY FILE ",$secondary->filename,": $error\n");
			}
		      }
		    }
		  }
		}
		die $@ if $@;
	      }} while (nextFile($grp));
	      die $@ if $@;
	    };
	  };
	  $hub->print("$control SERVER_RESPONSE_STDERR\n");
	  $hub->print("$@\n") if $@;
	  $hub->print("$control SERVER_RESPONSE_STDOUT\n");
	  _copy_output($macro_stdout,$hub);
	  $macro_stdout->close;
	  _revert_redirect_stdout($old_stdout);
	  _end_response($control,$hub);
	} elsif ($request{REQUEST_TYPE} eq 'CLOSE') {
	  my %fl;
	  my $listed = 0;
	  if (exists $request{STATE_FILELIST}) {
	    _msg "Closing some open of files at client's request\n";
	    $listed = 1;
	    %fl = map { $_ => 1 } grep { ref($grp->{preloaded}->{$_}) }
	      split /\n/,$request{STATE_FILELIST};
	  } else {
	    _msg "Closing all open files at client's request\n";
	  }
	  my $regexp = $request{STATE_REGEXP_FILES};
	  eval {
	    gotoFile($grp,0);
	    die $@ if $@;
	    do {{
	      next unless ref($grp->{FSFile});
	      if ((!defined($regexp) or $grp->{'FSFile'}->filename =~ $regexp)
		  and (!$listed or $fl{ $grp->{'FSFile'}->filename })) {
		closeFile($grp);
	      }
	      die $@ if $@;
	    }} while (nextFile($grp));
	    die $@ if $@;
	  };
	  closeAllPreloaded($grp);
	  @files=();
	  $hub->print("OK\n");
	  _end_response($control,$hub);
	} else {
	  $hub->print("ERROR: UNKNOWN REQUEST TYPE $request{REQUEST_TYPE}\n");
	  _end_response($control,$hub);
	}
	_msg("Waiting for a new request from the hub...\n\n");
      }
    }
  } else {
    # ----------------------------------------
    # INTERACTIVE MODE
    # ----------------------------------------

    if ($TrEd::Macros::exec_code=~/^\S*[nb]tred\s(.*)$/) {
      local @ARGV=split /\s+/,$1;
      print STDERR "Applying macro options: @ARGV\n" unless $quiet;
      local $all_trees if $no_all_trees;
      local $all_nodes if $no_all_nodes;
      $optparser->getoptions(
		  map {$_ => $optmap{$_}}
		  (
		   "all-trees|T",
		   "all-nodes|N",
		   "all-nonhidden-nodes|H",
		   "safe-mode|F",
		   "no-save",
		   "allow-switch-context",
		   "preload-files|P",
		   $initial_code ? () : ("initial-code|i=s"),
		   $code ? () : ("execute|e=s"),
		   $start_context ? () : ("context|t=s")));
      $context = $grp->{macroContext} = defined($start_context) ? $start_context : 'TredMacro';
    }
    if ($term_encoding) {
      $code=Encode::decode($term_encoding,$code);
      $initial_code=Encode::decode($term_encoding,$initial_code);
    } elsif ($code=~/[^[:ascii:]]/ and $locale_charset) {
      $code=Encode::decode($locale_charset,$code);
      $initial_code=Encode::decode($locale_charset,$initial_code);
    }
    $code||="autostart()"; # this is the default macro name
    init_safe_mode($grp) if $safe;
    my $pre='';
    $pre .= q[if ($TredMacro::root) { do {{ ] if ($all_trees);
    $pre .= q[while ($TredMacro::this) {] if ($all_nodes or $all_nonhidden_nodes);
    my $post.= q[  $TredMacro::this = $TredMacro::this->following; ]."\n}" if ($all_nodes);
    $post.= q[  $TredMacro::this = $TredMacro::this->following_visible($TredMacro::grp->{FSFile}->FS); ]."\n}"
      if (not $all_nodes and $all_nonhidden_nodes);
    $post.= q[ }} while TredMacro::NextTree(); }] if ($all_trees);
    my $cwd = fastcwd();
    my $premacro= <<EOL ;
#line 1 "$cwd/{btred ...}"
package $context;
sub _btred_eval_ {
$pre
#line 1 "$cwd/{btred -e}"
$code;
#line 4 "$cwd/{btred ...}"
$post
}

#line 1 "$cwd/{btred -i}"
$initial_code;
EOL

   _msg "<script>\n$premacro;\n</script>\n" if $tredDebug;
   doEvalMacro($grp,$premacro);

    exit if doEvalHook($grp,"start_hook") eq 'stop'; # run start_hook
    preloadFiles($grp,\@files) if $preload; # -P : load all files into memory

    exit if $preload and doEvalHook($grp,"preload_hook") eq 'stop'; # run start_hook
    if (@files) {
      my $status = openFile($grp,$files[$fileNo],-hook_can_stop => 1); # goto first file
      my $skip_next = ($status == 0) ? 1 : 0;
      do {{
        if ($skip_next) {
          _msg "Skipping: $files[$fileNo] (",$fileNo+1,"/$filecount)\n" unless $Quiet;
          $exit_code ||= ERROR_LOAD;
        } else {
          _msg "Processing: $files[$fileNo] (",$fileNo+1,"/$filecount)\n" unless $Quiet;
	  doEvalMacro($grp,"$context->_btred_eval_();");
	  STDOUT->flush();
	  STDERR->flush();
	  _msg "Done.\n" unless $quiet;
	  my ($out, $error) = saveFile($grp) if ($grp->{FSFile}->notSaved() or $save);
          if (defined $error) {
            _msg($error);
            $exit_code ||= ERROR_SAVE;
          }
          unless ($no_secondary) {
	    foreach my $secondary (secondaryDocumentsTo($grp,$grp->{FSFile})) {
	      if ($save or $secondary->notSaved()) {
	        # TODO: we should probably go recursion here...
	        # (secondary files of secondary files...)
	        my ($out,$error) = saveFile($grp,$secondary);
                if (defined $error) {
                  _msg("Error Saving secondary file:",$error);
                  $exit_code ||= ERROR_SAVE_SECONDARY;
                }
	      }
	    }
	  }
        }
        $status = nextFile($grp, -hook_can_stop => 1);
        $skip_next = ($status < 0) ? 1 : 0;
      }} while ($status != 0);
      closeFile($grp);
    } else {
      _msg "No files to process!\n" unless $Quiet;
    }
    doEvalHook($grp,"exit_hook");
    return $exit_code;
  }
  return 0;
}


sub lastFileNo {
  return $#files;
}

sub currentFileNo {
  return $fileNo;
}

sub gotoFile {
  my ($grp,$fn,%opts)=@_;
  return 0 if (doEvalHook($grp,"goto_file_hook") eq 'stop');
  return 0 if ($fn>$#files or $fn<0);
  $fileNo=$fn;
  my $result = openFile($grp,$files[$fileNo],%opts);
  return $result ? 1 : -1;
}


sub nextFile {
  my ($grp,%opts)=@_;
  return 0 if ($fileNo >= $#files);
  $fileNo++;
  my $result = openFile($grp,$files[$fileNo],%opts);
  return $result ? 1 : -1;
}

sub nextFileSkipBad {
  my ($grp,%opts)=@_;
  my $result=-1;
  while ($result < 0) {
    $result = nextFile($grp,%opts);
  }
  return $result>0 ? 1 : 0;
}

sub prevFile {
  my ($grp,%opts)=@_;
  return 0 unless ($fileNo > 0);
  $fileNo--;
  my $result = openFile($grp,$files[$fileNo],%opts);
  return $result ? 1 : -1;
}

sub _clear_err {
  undef $!; undef $@;
}
sub _last_err {
  my ($ret) = grep { defined and length } ($_[0], $@, conv_from_locale($!));
  $ret =~ s/^\s+|\s+$//g;
  return $ret;
}
sub _new_status {
  my %status = (
    ok => undef,
    cancel => undef,
    warnings => [],
    error => undef,
    filename => undef,
    backends => undef,
    report => undef,
    @_
  );
  return \%status;
}

sub loadFile {
  my ($file,$backends)=@_;
  my @warnings;
  my $bck = ref($backends) ? $backends : \@backends;
  my $status = _new_status(ok => 0, filename => $file, backends => $bck, warnings => \@warnings);
  _clear_err();
  local $SIG{__WARN__} = sub { my $msg = shift; chomp $msg; print STDERR $msg."\n"; push @warnings,$msg; };

  # a bit of a hack:
  local $Treex::PML::Backend::PML::allow_no_trees=1 if $allow_no_trees;

  my $fsfile = Treex::PML::Factory->createDocumentFromFile($file,
   {
     encoding => $TrEd::Convert::inputenc,
     backends => $bck
   });
  $status->{error} = _last_err();
  chomp $status->{error};
  $status->{report} = "Loading file '$file':\n";
  if (ref($fsfile) and ($allow_no_trees || $fsfile->lastTreeNo>=0)
       and $Treex::PML::FSError==0) {
    $status->{ok} = @warnings ? -1 : 1;
  } else {
    $status->{ok} = 0;
    if (ref($fsfile) and !$allow_no_trees and $Treex::PML::FSError==0) {
      $status->{error} = "No trees found in this file; if it is ok, try --allow-no-trees.";
    }
    $status->{report} .= "ERROR(s): ".$status->{error}."\n";
  }
  if (@warnings) {
    $status->{report} .= "WARNING(s): ".join("\n", @warnings);
  }
  if (wantarray) {
    return ($fsfile, $status);  
  } else {
    return $fsfile;
  }
}

sub preloadFiles {
  my ($grp, $filelist, $errlog)=@_;
  $errlog = \*STDERR unless ref($errlog);
  my $filecount=@$filelist;
  my $fno=1;
  foreach my $f (@$filelist) {
    if ($f=~/(##?[0-9A-Z]+(?:\.[0-9]+)?)$/) {
      $f=~s/(##?[0-9A-Z]+(?:\.[0-9]+)?)$//;
    }
    next if exists($grp->{preloaded}->{$f});
    _msg "Pre-loading: $f (",$fno++,"/$filecount)\n" unless $Quiet;
    my ($fsfile,$status) = loadFile($f,\@backends);
    if ($status->{ok} != 1) {
      _msg($status->{report});
      $errlog->print($status->{report}) if ($errlog);
    }
    next unless ($status->{ok} && 
		 openSecondaryFiles($grp,$fsfile, $errlog));

    $fsfile->changeFileFormat(($f=~/\.gz$/ ? "gz-compressed " : "").$fsfile->backend);
    $grp->{preloaded}->{$f} = $fsfile;
  }
  @files=grep { exists($grp->{preloaded}->{$_}) } @files;
  _make_uniq(\@files);
}

sub associateSecondary {
  my ($secondary,$fsfile,$as) = @_;

  $secondary->changeAppData('fs-part-of',[]) 
    unless ref $secondary->appData('fs-part-of');
  push @{ $secondary->appData('fs-part-of') }, $fsfile; # is this a good idea?
  $fsfile->changeAppData('ref',{}) unless ref $fsfile->appData('ref');
  $fsfile->appData('ref')->{$as}=$secondary;
}

sub openSecondaryFiles {
  my ($grp,$fsfile,$errlog)=@_;
  my $return = 1;
  unless ($no_secondary) {
    my $requires = $fsfile->metaData('fs-require');
    if ($requires) {
      for my $req (@$requires) {
	my $req_filename = absolutize_path($fsfile->filename,$req->[1]);
	_msg("Pre-loading dependent $req_filename as appData('ref')->{$req->[0]}\n") if $tredDebug;
	unless ($grp->{'secondary'}->{$req_filename}) {
	  if (exists($grp->{preloaded}) and $grp->{preloaded}->{$req_filename}) {
	    $grp->{'secondary'}->{$req_filename} =
	      $grp->{'preloaded'}->{$req_filename};
	    associateSecondary($grp->{'preloaded'}->{$req_filename},
			       $fsfile,
			       $req->[0]);
	  } else {
	    my ($req_fs,$status) = loadFile($req_filename,$TrEd::Convert::inputenc,\@backends);
	    unless ($status->{ok}) {
	      _msg("Error - cannot load secondary file $req_filename required by ".$fsfile->filename.": ".
		     $status->{report});
	      $errlog->print($status->{report}) if ($errlog);
	      $return = 0;
	    }
	    $req_fs->changeFileFormat(($req_filename=~/\.gz$/ ? "gz-compressed " : "").$req_fs->backend);
	    $grp->{'secondary'}->{$req_filename} = $req_fs;
	    associateSecondary($req_fs,
			       $fsfile,
			       $req->[0]);
	    $return &&= openSecondaryFiles($grp,$req_fs,$errlog);
	  }
	} else {
	  # secondary file is already loaded, just associate:
	    associateSecondary($grp->{'secondary'}->{$req_filename},
			       $fsfile,
			       $req->[0]);
	}
      }
    }
  }
  return $return;
}

sub resumeFile {
  my ($grp,$fsfile)=@_;
  my $f = $fsfile->filename;
  $grp->{FSFile} = $fsfile;
  $grp->{preloaded}->{$f}=$fsfile if ($fsfile and exists($grp->{preloaded}));
  my $encoding=$fsfile->encoding;
  if (!$term_encoding and $encoding ne "") {
    _set_encoding(\*STDERR,$encoding,"STDERR");
    _set_encoding(\*STDOUT,$encoding,"STDOUT");
  }
  $grp->{treeNo}=0;
  $grp->{root}=$fsfile->tree(0);
  $grp->{currentNode}=$grp->{root};
}

sub openFile {
  my ($grp,$f,%opts) = @_;
  if (doEvalHook($grp,"open_file_hook",$f,{%opts}) eq 'stop') {
    # not sure what status should we return
    return 1;
  }

  my $goto = undef;
  my %fs=(fs => 'FS format',
	  fgz => 'gzipped FS format',
	  trxml => 'tree XML format',
	  any => 'any non-specific format (csts?), using CstsToFs');

  ($f,$goto) = parseFileSuffix($f);
  my $return = 1;
  unless ($grp->{FSFile} and $grp->{FSFile}->filename eq $f) {
    closeFile($grp);
    if (exists($grp->{preloaded}) and
	  exists($grp->{preloaded}->{$f})) {
      $grp->{'FSFile'} = $grp->{preloaded}->{$f};
    } elsif ($opts{-secondary} and exists($grp->{secondary}) and exists($grp->{secondary}->{$f})) {
      $grp->{'FSFile'} = $grp->{secondary}->{$f};
    } elsif ($opts{-justpreloaded}) {
      return 0;
    } else {
      my ($fsfile,$status) = loadFile($f,\@backends);
      $return = $status->{ok} != 0;
      _msg($status->{report}) unless $status->{ok} == 1;

      $grp->{FSFile} = $fsfile;
      $fsfile->changeFileFormat(($f=~/\.gz$/ ? "gz-compressed " : "").$fsfile->backend);
      $grp->{preloaded}->{$f}=$fsfile if ($fsfile and exists($grp->{preloaded}));

      # open files required by this one
      $return &&= openSecondaryFiles($grp,$fsfile);
    }

    my $encoding=$grp->{FSFile}->encoding;
    if (!$term_encoding and $encoding ne "") {
      _set_encoding(\*STDERR,$encoding,"STDERR");
      _set_encoding(\*STDOUT,$encoding,"STDOUT");
    }
  }
  $grp->{treeNo}=0;
  $grp->{root}=$grp->{FSFile}->tree(0);
  $grp->{currentNode}=$grp->{root};
  applyFileSuffix($grp,$goto);
  unless ($opts{-justpreloaded}) {
    doEvalHook($grp,"guess_context_hook","file_opened_hook");
    my $hook_result = doEvalHook($grp,"file_opened_hook");
    if ($opts{'-hook_can_stop'} and
	  $hook_result eq 'stop') {
      $return = 0;
    }
  }
  if ($grp->{FSFile} and !defined($grp->{currentNode})) {
    $grp->{currentNode}=$grp->{root};
  }

#  updateTredMacroGlobals($grp);
  return $return;
}

sub _has_suffix {
  return $_[0]=~/##?[0-9A-Z]+(?:\.\d+)?$/
}

sub applyFileSuffix {
  my ($grp,$goto)= @_;
  return unless $grp;
  my $fsfile = $grp->{FSFile};
  return unless $fsfile and defined($goto) and $goto ne q//;

  if ($goto=~/^##([0-9]+)/) {
    my $no = int($1 - 1);
    $grp->{treeNo}=min(max(0,$no),$fsfile->lastTreeNo);
    $grp->{root} = $fsfile->tree($grp->{treeNo});
    return 0 if $grp->{treeNo} != $no;
  } elsif ($goto=~/^#([0-9]+)/) {
    # this is PDT 1.0-specific code, sorry
    my $no;
    for (my $i=0;$i<=$fsfile->lastTreeNo;$i++) {
      if ($fsfile->treeList->[$i]->{form} eq "#$1") {
	$no=$i; last;
      }
    }
    return 0 unless defined $no;
    $grp->{treeNo}=$no;
  } elsif ($goto=~/^#([^#]+)$/) {
    my $id = $1;
    if (Treex::PML::Schema::CDATA->check_string_format($id,'ID')) {
      my $id_hash = $fsfile->appData('id-hash');
      if (UNIVERSAL::isa($id_hash,'HASH') and exists($id_hash->{$id})) {
	my $node = $id_hash->{$id};
	# we would like to use Treex::PML::Index() here, but can't
	my $list = $fsfile->treeList;
	my $root = UNIVERSAL::can($node,'root') && $node->root;
	my $n = defined($root) && first {
	  $list->[$_]==$root;
	} 0..$#$list;
	if ($root and !defined($n)) {
	  # hm, we have a node, but don't know to which tree
	  # it belongs
	  my $trees_type = $fsfile->metaData('pml_trees_type');
	  my $root_type = $root->type;
	  if ($trees_type and $root_type) {
	    my $trees_type_is = $trees_type->get_decl_type;
	    my %paths;
	    my $is_sequence;
	    my $found;
	    my @elements;
	    if ($trees_type_is == Treex::PML::Schema::PML_LIST_DECL()) {
	      @elements = ['LM',$trees_type->get_content_decl];
	    } elsif ($trees_type_is == Treex::PML::Schema::PML_SEQUENCE_DECL()) {
	      @elements = map { [$_->get_name,$_->get_content_decl] } $trees_type->get_elements;
	      $is_sequence=1;
	    } else {
	      return 0;
	    }
	    for my $el (@elements) {
	      $paths{$el->[0]} = [$trees_type->get_schema->find_decl(
		sub {
		  $_[0] == $root_type
		}, $el->[1],{})];
	      $found = 1 if @{ $paths{$el->[0]} };
	    }
	    return 0 unless $found;
	    TREE:
	    for my $i (0..$#$list) {
	      my $tree = $list->[$i];
	      my $paths = $is_sequence ? $paths{$tree->{'#name'}} : $paths{LM};
	      for my $p (@{$paths||[]}) {
		for my $value ($tree->all($p)) {
		  if ($value == $root) {
		    $n = $i;
		    last TREE;
		  }
		}
	      }
	    }
	  }
	}
	if (defined($n)) {
	  $grp->{treeNo}=$n;
	  $grp->{currentNode}=$node;
	  return 1;
	} else {
	  return 0;
	}
      }
    }
  }
  # new: we're the dot in .[0-9]+ (TM)
  if ($goto=~/\.([0-9]+)$/) {
    my $node=getNodeByNo($grp,$1);
    if ($node) {
      $grp->{currentNode}=$node;
      return 1;
    } else {
      return 0;
    }
  } elsif ($goto=~/\.([^0-9#][^#]*)$/) {
    my $id = $1;
    if (Treex::PML::Schema::CDATA->check_string_format($id,'ID')) {
      my $id_hash = $fsfile->appData('id-hash');
      if (UNIVERSAL::isa($id_hash,'HASH') and exists($id_hash->{$id})) {
	return 1 if ($grp->{currentNode}=$id_hash->{$id}); # assignment
      } else {
	return 0;
      }
    }
  }
  return 1;
}


# sub OLD_applyFileSuffix {
#   my ($grp,$goto) = @_;
#   return unless ref($grp) and defined($goto) and $goto ne "";
#   # -- smells like PDT-specific code, at least the second case
#   # but we want it, dont we:)

#   my $fsfile=$grp->{FSFile};
#   if ($goto=~/^##([0-9]+)/) {
#       warn "BEFORE $grp->{treeNo}";
#     $grp->{treeNo}=min2(max2(0,$1-1),$fsfile->lastTreeNo);
#       warn "AFTER  $grp->{treeNo}";
#   } elsif ($goto=~/^#(.+)/) {
#     for (my $i=0;$i<=$fsfile->lastTreeNo;$i++) {
#       $grp->{treeNo}=$i,last if ($fsfile->treeList->[$i]->{id} eq $1);
#     }
#   }
#   # new: we're the dot in .[0-9]+ (TM)
#   my $root;
#   if ($goto=~/\.([0-9]+)$/) {
#     $root=$fsfile->treeList->[$grp->{treeNo}];
#     my $i=$1;
#     while ($root and $i>0) {
#       $i--;
#       $root=$root->following();
#     }
#     $grp->{currentNode}=$root if ($root);
#     warn "RETURN $grp->{treeNo}";
#   }
# }

sub checkLock {
  my ($f) = @_; # filename
  return "none" if (not $f=~s{^file://}{} and $f =~ m{^[[:alnum:]]+://});
  my $lockinfo = "none";
  if (-f $f.".lock") {
    eval { open my $l, $f.".lock"; $lockinfo = <$l>; $lockinfo =~ s/[\n\r]+$//; close $l; };
  }
  return $lockinfo;
}

sub save_transform_filename {
  my ($out)=@_;
  $out=~s/$strip_suffix$// if ($strip_suffix ne "");
  $out.=$append_suffix;
  $out=~s/^$strip_prefix// if ($strip_prefix ne "");
  $out=$add_prefix.$out if ($add_prefix ne "");
  return $out;
}

sub saveFile {
  my ($grp,$fsfile)=@_;
  return if $nosave;
  $fsfile = $grp->{'FSFile'} unless defined $fsfile;
  return unless $fsfile;
  my $f=$fsfile->filename;
  if ($obey_locks) {
    my $lockinfo = checkLock($f);
    if ($lockinfo ne 'none') {
      return (undef,"file locked $lockinfo\n");
    }
  }
  $fsfile->changeBackend($backend) if ($backend);
  my $out=save_transform_filename($f);
  my $err = '';
  eval {
    Treex::PML::IO::rename_uri($out,$out."~") unless $f=~/^ntred:/; # if (-f $f);
  };
  $err.="Error creating backup $f~: $@\n" if $@;
  #unlink "$f~" if (-e "$f~" ); # silly MS OSs need this
  #rename $f, "$f~" if (-f $f);
  my $refs_to_save={};
  if ($reffiles_to_save eq 'ALL') {
    my $references = $fsfile->metaData('references');
    if (ref($references)) {
      foreach my $refid (keys %$references) {
	my $href = $references->{$refid};
	if ($refid and $href) {
	  $refs_to_save = {} unless defined $refs_to_save;
	  $refs_to_save->{$refid} = save_transform_filename($href);
	  _msg "Reference with ID $refid from file '$href' will be saved as ".$refs_to_save->{$refid}."\n" unless $Quiet;
	}
      }
    }
  } elsif ($fsfile->metaData('schema') and $reffiles_to_save ne 'NONE') {
    # _msg "Looking for reffiles $reffiles_to_save\n" unless $Quiet;
    my $refnames = $fsfile->metaData('refnames');
    my $references = $fsfile->metaData('references');
    if (ref($refnames) and ref($references)) {
      foreach my $name (split /\s*,\s*/,$reffiles_to_save) {
	_msg "Looking for resource '$name'\n" unless $Quiet;
	my $refid = $refnames->{$name};
	my $href = $references->{$refid};
	if ($refid and $href) {
	  $refs_to_save = {} unless defined $refs_to_save;
	  $refs_to_save->{$refid} = save_transform_filename($href);
	  _msg "Reference '$name' from file '$href' will be saved as ".$refs_to_save->{$refid}."\n" unless $Quiet;
	}
      }
    }
  }

  if ($fsfile == $grp->{FSFile} and doEvalHook($grp,"file_save_hook",$out) eq 'stop') {
    return ($out,"Saving of $f stopped by file_save_hook\n");
  } else {
    _msg "Saving $f as $out\n" unless $Quiet;
  }

  $fsfile->changeAppData('refs_save',$refs_to_save);
  my $result = eval { $fsfile->writeFile($out)  };
  $fsfile->changeAppData('refs_save',undef);
  if ($@ or !$result) {
    $err .= "Error saving file to '$out'\n";
    $err .= $@ if $@;
    # try revert backup
    eval {
      Treex::PML::IO::rename_uri($out."~",$out) unless $out=~/^ntred:/; # if (-f $f);
    };
    $err .= "Error reverting $f from backup $f~ after saving error: $@\n" if $@;
    return ($out,$err);
  }
  Treex::PML::IO::unlink_uri($out."~") if $no_backups;
  $fsfile->notSaved(0);
  return ($out, undef);
}

sub fileOrSecondariesNotSaved ($$) {
  my ($grp,$fsfile)=@_;
  return $fsfile->notSaved() or
    (!$no_secondary and first { $_->notSaved() } secondaryDocumentsTo($grp,$fsfile));
}

sub secondaryFiles {
  my ($fsfile)=@_;
  my $requires = $fsfile->metaData('fs-require');
  if ($requires) {
    return map { absolutize_path($fsfile->filename,$_->[1]) } @$requires;
  } else {
    return ();
  }
}

sub secondaryDocumentsTo ($$) {
  my ($grp,$fsfile)=@_;
  return grep { ref($_) } map { $grp->{secondary}->{$_} } secondaryFiles($fsfile);
}

sub closeFile {
  my ($grp)=@_;
  doEvalHook($grp,"file_close_hook") if $grp->{FSFile};
  no strict qw(refs);
  set_macro_variable('TredMacro::NodeClipboard' => undef);
  # close required files too, unless file remains pre-loaded
  closeSecondaryFilesOf($grp,$grp->{FSFile});
  $grp->{root}=undef;
  $grp->{FSFile}=undef;
  $grp->{treeNo}=undef;

  delete $grp->{'currentNode'} if (exists $grp->{'currentNode'});
}

# in oreder for a file to close it's dependencies, it
# has to be removed from preloaded first
sub closeSecondaryFilesOf {
  my ($grp,$fsfile)=@_;
  if ($fsfile and (!exists($grp->{preloaded}) or $grp->{preloaded}->{$fsfile->filename} != $fsfile)) {
    my $requires = $fsfile->metaData('fs-require');
    for my $req (@$requires) {
      my $req_filename = absolutize_path($fsfile->filename,$req->[1]);
      my $secondary = $grp->{'secondary'}->{$req_filename};
      if ($secondary) {
	closeSecondaryFilesOf($grp,$secondary);
	my $part_of = $secondary->appData('fs-part-of');
	@$part_of = grep { $_ != $fsfile } @$part_of;
	unless (@$part_of) {
	  # close secondary file
	  delete $grp->{'secondary'}->{$req_filename};
	  delete $fsfile->appData('ref')->{$req->[0]} if ref($fsfile->appData('ref'));
	}
      }
    }
  }
}

sub closePreloadedFile {
  my ($grp,$f)=@_;
  my ($fsfile,$filename);
  if (ref($f)) {
    # it's a FSFile
    $fsfile = $f;
    $filename = $f->filename;
  } else {
    return unless $grp->{preloaded};
    $fsfile = $grp->{preloaded}->{$f};
    $filename = $fsfile->filename;
  }
  delete $grp->{preloaded}->{$filename} if exists($grp->{preloaded});
  closeSecondaryFilesOf($grp,$fsfile)
}

sub closeAllPreloaded {
  my ($grp)=@_;
  return unless exists($grp->{preloaded});
  my @preloaded = values %{$grp->{preloaded}};
  # first clear preloaded hash
  %{$grp->{preloaded}}=();
  # then close secondary files
  for my $fsfile (@preloaded) {
    closeSecondaryFilesOf($grp,$fsfile)
  }
}

sub doEvalHook {
  my ($group,$hook)=(shift,shift);
  return if $NO_HOOKS;
  no strict qw(refs);
  return unless $hook;# and $group->{'currentNode'};

  my $old_ctxt = TrEd::Macros::save_ctxt();
  set_macro_variable('TredMacro::this' => $group->{currentNode},
		     'TredMacro::root' => $group->{root},
		     'TredMacro::libDir' => $libDir,
		     'TredMacro::FileNotSaved' => '?',
		     'TredMacro::forceFileSaved' => 0);
  my $result=do_eval_hook($group,$group->{macroContext},$hook);
  _msg "$@" if $@;
  exit ($exit_code|ERROR_HOOK) if ($@ and !$warn_only and !$start_server);

  if ($group->{FSFile}) {
    if (get_macro_variable('FileNotSaved') eq '?') {
      set_macro_variable('FileNotSaved' => $group->{FSFile}->notSaved);
    }
    $group->{FSFile}->notSaved($group->{FSFile}->notSaved or 
		      get_macro_variable('FileNotSaved'));
  }
  TrEd::Macros::restore_ctxt($old_ctxt);

  _msg "Hook $hook resulted with $result\n" if $hookDebug;
  return $result;
}

sub doEvalMacro {
  my ($group,$macro)=(shift,shift);
  return unless $macro;
  no strict qw(refs);
  set_macro_variable(
    this => $group->{currentNode},
    root => $group->{root},
    libDir => $libDir,
    FileNotSaved => '?',
    forceFileSaved =>0);

  my $result=do_eval_macro($group,$macro);
  exit ($exit_code|ERROR_MACRO) if ($@ and !$warn_only and !$start_server);

  if ($group->{FSFile}) {
    set_macro_variable('FileNotSaved' => 0)
      if get_macro_variable('FileNotSaved') eq '?';
    if (get_macro_variable('forceFileSaved')) {
      $group->{FSFile}->notSaved(get_macro_variable('FileNotSaved'));
    } else {
      $group->{FSFile}->notSaved($group->{FSFile}->notSaved or
				 get_macro_variable('FileNotSaved'));
    }
    setCurrent($group,get_macro_variable('this')) if (get_macro_variable('this'));
  }
  set_macro_variable(
    this => undef,
    root => undef,
    grp => undef
   );
  return $result;
}

sub init_tredmacro {
  my ($grp)=@_;
  $TrEd::Macros::macrosEvaluated=0;
  $TrEd::Macros::safeCompartment=undef;
  if ($safe) {
    init_safe_mode($grp);
  } else {
    TrEd::Macros::initialize_macros($grp);
  }
}


sub packages_under {
  my ($base)=@_;
  no strict qw(refs);
  my @pkgs = ($base.'::');
  my %pkgs = map { $_ => 1 } @pkgs;
  for (my $i=0; $i<=$#pkgs;$i++) {
    foreach (keys %{$pkgs[$i]}) {
      next if $_ eq 'main::';
      if (/::$/ and !exists($pkgs{$pkgs[$i].$_})) {
	push @pkgs,$pkgs[$i].$_;
	$pkgs{ $pkgs[$i].$_ }=1;
      }
    }
  }
  return keys %pkgs;
}

sub cleanup_tredmacro {
  my ($grp,@macros)=@_;
  $TrEd::Macros::macrosEvaluated=0;
  # cleanup
  my %packages;
  @packages { ('TredMacro',
	       grep {/\S/} grep { !/^main$|^TrEd::/ }
	       map  { (/^package\s+([^;\s]+)\s*;/) } (@TrEd::Macros::macros,@macros))
	    } = ();

  if ($safe) {
    if ($TrEd::Macros::safeCompartment) {
      $TrEd::Macros::safeCompartment->reval(<<'EOF');
      package TredMacro;
undef $this;
undef $root;
undef $nodeClipboard;
EOF
      _msg($@) if $@;
      no strict qw(refs);

      my @pkgs = packages_under('TredMacroCompartment');
      foreach my $package (sort { length($b)<=>length($a) } @pkgs) {
	$_ERR->flush();
	%{$package}=();
      }
      $_ERR->flush();
      $TrEd::Macros::safeCompartment->erase();
      $_ERR->flush();
    }
    undef %{main::TredMacroCompartment::TredMacro};
    undef %{main::TredMacroCompartment::};
  } else {
    # prune also all packages based on TredMacro:
    foreach my $pkg ( grep { !exists($packages{$_}) and UNIVERSAL::isa($_,'TredMacro') }
			map { /^::(.+)\:\:$/ ? $1 : () } packages_under('') ) {
      my $pkg_file = $pkg;
      $pkg_file =~ s{::}{/}g;
      $pkg_file .= '.pm';
      _msg "Discovered non-#included TredMacro-based package: ".$pkg."\n";
      _msg "Trying to un-require the module: ".(delete $INC{$pkg_file})."\n";
      $packages{$pkg}=undef;
    }
    foreach my $package ( sort { length($b)<=>length($a) } keys %packages ) {
      no strict qw(refs);
      _msg("Cleaning package $package\n") if $tredDebug;
      my $pkg_file = $package;
      $pkg_file =~ s{::}{/}g;
      $pkg_file .= '.pm';
      %{$package."::"}=();
      delete $INC{$pkg_file};
      eval("package $package; use UNIVERSAL qw(isa can);");
      _msg($@) if $@;
    }
  }
  $TrEd::Macros::safeCompartment=undef;
}

sub init_safe_mode {
  my ($grp)=@_;
  require Safe;
  $TrEd::Macros::macrosEvaluated=0;
  if (ref($TrEd::Macros::safeCompartment)) {
    $TrEd::Macros::safeCompartment->erase();
  }
  $TrEd::Macros::safeCompartment=undef;
  %{TredMacroCompartment::}=(); # cleanup
  my $compartment = Safe->new('TredMacroCompartment');
  $compartment->{Erase} = 1;
  $compartment->reval("package TredMacro;");
  $compartment->deny_only(qw()); # everything allowed for the first initialization
  $compartment->share(qw(&do_eval_macro &do_eval_hook &min &max &min2 &max2 @INC 
                         &nextTree &prevTree &gotoTree 
			 &lastFileNo &currentFileNo $stderr $stdout
			 &switchContext
			));
  $compartment->share_from('TrEd::Config',[qw($libDir)]);

  $TrEd::Macros::safeCompartment=$compartment;
  TrEd::Macros::initialize_macros($grp);
# OPCODES ALLOWED IN SAFE MODE

#			       :base_io :base_orig :filesys_read :filesys_open
#			       :filesys_write
  $compartment->permit_only(qw(:base_core :base_mem :base_loop :base_math :base_orig
			       entereval caller dofile
			       print entertry leavetry tie untie bless
			       sprintf localtime gmtime sort require));
  $compartment->deny(qw(getppid getpgrp setpgrp getpriority setpriority
			pipe_op sselect select dbmopen dbmclose tie untie
		       ));
  $TrEd::Macros::safeCompartment=$compartment;
}

sub switchContext {
  return unless $allow_switch_context;
  my ($grp,$context)=@_;

  my $prevcontext=$grp->{macroContext};
  $grp->{macroContext}=$context;
  my $ret = doEvalHook($grp,"allow_switch_context_hook",$prevcontext,$context);
  if ($ret eq 'stop') {
    $grp->{macroContext}=$prevcontext;
    return 0;
  }
  $grp->{macroContext}=$prevcontext;
  return 0 if (doEvalHook($grp,"pre_switch_context_hook",$prevcontext,$context) eq 'stop');
  $grp->{macroContext}=$context;
  doEvalHook($grp,"switch_context_hook",$prevcontext,$context);
}

sub updateTredMacroGlobals {
  my ($grp)=@_;
  no strict qw(refs);
  set_macro_variable(root => $grp->{root},
		     this => $grp->{currentNode});
}

sub determineNodeType {
  my ($grp,$node)=@_;
  my $type = $node->type;
  return $type if $type;
  doEvalHook($grp,'determine_node_type_hook',$node);
  return $type if $type;
  $grp->{FSFile}->determine_node_type($node => {
     choose_command => sub {
       my (undef,undef,$ntypes)=@_;
       die "Could not determine node type, there were the following possibilities: ".
	 join(",",map { $_->[1] } @$ntypes);
     },
  });
  return $node->type;
}

sub prepareExtensions {
  my ($opts)=@_;
  $opts||={};
  my $extensions = getExtensionList();
  my $preinst_dir = getPreInstalledExtensionsDir();
  my $pre_installed;
  {
    my (%e,%d);
    @e{ split /,/,$enable_extensions }=();
    @d{ split /,/,$disable_extensions }=();
    if ($macro) {
      _msg("Using -m implies all extensions disabled...\n") unless $quiet;
    }
    @$extensions =
      map { /^!(.*)/ ?
	      (exists($e{'*'}) && !exists($d{$1}) || exists($e{$1}) ? $1 : $_)
		: $macro ?
		  (exists($e{'*'}) && !exists($d{$_}) || exists($e{$_}) ? $_ : '!'.$_)
		    : (exists($d{'*'}) && !exists($e{$_}) || exists($d{$_}) ? '!'.$_ : $_)
		  } @$extensions;
    $pre_installed =  getPreInstalledExtensionList($extensions);
    @$pre_installed =
    map { /^!(.*)/ ?
	    (exists($e{'*'}) && !exists($d{$1}) || exists($e{$1}) ? $1 : $_)
	      : $macro ?
		(exists($e{'*'}) && !exists($d{$_}) || exists($e{$_}) ? $_ : '!'.$_)
		  : (exists($d{'*'}) && !exists($e{$_})|| exists($d{$_}) ? '!'.$_ : $_)
		} @$pre_installed;
    my %have; @have{@$extensions,@$pre_installed}=();
    for my $required (keys %e) {
      if ($required ne '*' and !exists($have{$required})) {
	warn("WARNING: extension $required not found!");
      }
    }
  }
  if (my $fh = $opts->{list_to}) {
    $fh->print( map "$_\n", @$extensions );
    $fh->print( map "$_\t(pre-installed)\n", @$pre_installed );
  }
  return ($extensions,$pre_installed,$preinst_dir);
}
sub loadMacros {

  _msg("Reading macros from $macroFile...\n") unless $quiet;
  read_macros($macroFile,$libDir);	# read macros

  my ($extensions,$pre_installed,$preinst_dir) = prepareExtensions();
  initExtensions($extensions);
  initExtensions($pre_installed,$preinst_dir);
  _msg("Reading extension macros...\n") unless $quiet;
  for my $ext_contrib (getExtensionMacroPaths($extensions),
		       getExtensionMacroPaths($pre_installed,$preinst_dir)) {
    _msg("Reading extension macros from $ext_contrib...\n") unless $quiet;
    push @TrEd::Macros::macros,qq(\n#line 0 "$ext_contrib"\n{\npackage TredMacro;\n);
    read_macros($ext_contrib,$libDir,1);
    push @TrEd::Macros::macros,qq(\n\n=pod\n\n=cut\n\n} # end of "$ext_contrib"\n);
  }
  if ($include_macro) {
    _msg("Reading additional macros from $include_macro...\n") unless $quiet;
    push @TrEd::Macros::macros,qq(\n#line 0 "$include_macro"\n{\npackage TredMacro;\n);
    read_macros($include_macro,$libDir,1);
    push @TrEd::Macros::macros,qq(\n\n=pod\n\n=cut\n\n} # end of "$include_macro"\n);
  }
}

__END__

=head1 btred

btred - non-interactive scriptable version of the tree editor TrEd

=head1 SYNOPSIS

  btred [-c config-file]
        [-t context] [-m|-I macro-file] [-e code] [-i init-code]
        [-N|-H] [-T] [-S | --no-save] [--knit] [-P] [-F]
        [-s strip-sfx] [-a append-sfx] [-p strip-prefix] [-r add-prefix]
        [-f out-fmt] [-n file-encoding] [-d terminal-encoding]
        [-W] [-q|-Q] [-D] [-V] [-L port] [-b hub]
        [-x extra_attribs] [-X gov,ord?,hide?] [-R]
        [-o script options -- ] [-l file-list] files...
or
  btred -u          for usage
  btred -h          for help
  btred --man       for the manual page

=head1 DESCRIPTION

btred is an off-line TrEd macro processor which applies macros on given files

=head1 OPTIONS

=head2 Filename arguments

Each filename on the command-line or in a file list may be optionally
followed by a suffix which identifies a node to be selected when the
file is opened (this means that C<$this> will point the the selected
node and C<$root> will point to the root of that tree). The suffix can
be of one of the following following forms:

#ID     where ID is an identifier of a node (for file formats that have
        identifiers, e.g. PML).

##N     where N is a number. This selects the root of the N-th tree

##N.M   where N and M are numbers. This selects the M-th node in 
        the depth-first order in the N-th tree.

=over 8

=item B<--macro-file|-m> filename

File with macro definitions to load instead of the standard macro file
(by default C<tred.mac>).

WARNING: since extensions may require the standard macro file, using
this option automatically disables all extensions. One may use
C<--enable-extensions extension-list...> to selectively enable
required extensions.

=item B<--include-macro-file|-I> filename

A file containing additional set of macros to load. This option is
typically used instead of C<--macro-file> to allow loading macros
B<both> from C<filename> B<and> the default macro set (C<tred.mac>).
C<--macro-file> can still be used in combination with
B<--include-macro-file> to supply a replacement for C<tred.mac>.

=item B<--execute|-e> perl-code

Macro code to apply to given files. If no code is specified, btred
expects a function called `autostart' to be defined in the used
context and defaults to `autostart()' as the macro code.

The macro code may use all functions defined in a given macro file,
the default macro file tred.def, plus all functions and methods from
Treex::PML (see Treex::PML documentation).

Note, that a lot of information on the current node, file etc. can be
obtained using some pre-defined macro from `tred.def'. The
documentation for `tred.def' is a highly recommended reading for btred
macro coder and macros defined there in should be prefered in all
applicable situations.

As in TrEd, the following variables can be used in macros:

$this - the current node (the root of the first tree in a file at the
beginning)

$root - the root node of the current tree

Among many other, the following functions are defined (see 'tred.def' for a full list):

CurrentFile() - current FSFile object (see section on FSFile in Treex::PML
documentation)

CurrentTreeNumber() - current tree number

CurrentContext() - current macro context

ChangingFile() - - macro may call this function to indicate that the
file should be saved at the end of the pocessing.

=item B<--initial-code|-i> code

Code to be evaluated before any file is open.

=item B<--context|-t>

Start in a given macro context (Perl package).
The default context is `TredMacro'.

=item B<--preload-module|-M> module-name

Preload a given Perl module at btred startup so as it is available to
all macros (even if running in a safe compartment).  This option may
be specified more than once with different modules.

=item B<--filelist|-l> file-list

Read a list of filenames to process from a given file (one filename
per line). Files specified in a file-list are processed prior to files
specified on the command-line. If file-list is a file with .fl
extension, then the first line may contain a file-list name (as in
TrEd). Moreover, unlike in other file-lists, filenames in .fl
file-lists are asssumed to be relative to the file-list file location.

=item B<--glob|-g>

Apply Perl C<glob> function on the filename patterns given on the
command-line.  This expands possible wild-card patterns on each of the
filename command-line argument as the standard Unix shell /bin/csh
would do. This can not only help in a situation where the shell used
does not support wildcard expansion, but can also be used to reduce the
number of the command-line arguments passed to the process in cases
where the argument list would after the shell-expansion exceed a
system limit. By default, this flag is 'on' for the Windows platform
and 'off' on all other systems.

=item B<--strip-prefix|-p> regexp

Remove strings matching a given regexp from the beginning of filenames
before saving.

=item B<--add-prefix|-r> prefix

Prepend output filenames with a given prefix.

=item B<--strip-suffix|-s> regexp

Strip strings matching a given regexp from the end of filenames.

=item B<--add-suffix|-a> suffix

Append a given suffix to the filenames.

=item B<--output-format|-f> [fs|csts|trxml|tei|storable]

Format to use for files being saved.

=item B<--config-file|-c> filename

TrEd configuration file (overrides ~/.tredrc).

=item B<--option|-O> name=value

Override configuration option from the config file with a given
value. This flag can be used several times for different options.

Special syntax of the name part allows some modifications of existing
option values for options that are delimited lists (this cannot be
used to modify default or implicit values):

=over 8

=item nameX=value

Treat the option as a list delimited by the delimiter X and
prepend the value to the list.

=item  nameX+=value

Treat the option as a list delimited by the delimiter X and append the
value to the list.

=item  nameX-=value

Treat the option as a list delimited by the delimiter X and remove the
value from the list (if exists).

=back

Only the following characters can be used as a delimiter:

      ; : , & | / + - \s \t SPACE

where SPACE is a space character, \s matches arbitrary white-space,
and \t matches TAB character.

The options can be combined; for example

  -O "extensionRepos\\s"-=http://foo/bar -O "extensionRepos\\s"+=http://foo/bar

first removes any occurrence of the URL http://foo/bar from the
white-space separated list of extensionRepos and then appends the URL
to the end of the list.

=item B<--resource-dir|-Z> dirname

Specifies resource path. This option can be repeated and overrides
ResoucePath setting in the TrEd configuration file.

Individual paths can also be separated by colon (POSIX/Unix) or
semi-colon (Windows) separator. If there is a lone leading or trailing
separator, the default resource path is prepended or appended,
respectively.

=item B<--all-trees|-T>

Apply the macro code to all trees (wrapping the code into a
C<if ($root) { do {{ CODE }} while TredMacro::NextTree() }> loop).

=item B<--all-nodes|-N>

Apply the macro code tn all nodes (you still must use --all-trees or
-T to aplly to all trees in a file) (wrapping the code into a C<while
($this) { CODE ; $this=$this-E<gt>following };> loop).

=item B<--all-nonhidden-nodes|-H>

Apply the macro code to all nodes except the hidden ones (you still
must use --all-trees or -T to process all trees in a file). This
option wraps the code into a C<while ($this) { CODE ;
$this=$this-E<gt>following_visible(FS()) };> loop).

=item B<--file-encoding|-n> encoding

Allows to specify character encoding of input files (does not apply to
XML files).

=item B<--terminal-encoding|-d> encoding

Automatically apllies a given character encoding to all stdout and
stderr output operations. Works only with Perl >= 5.8.

=item B<--save|-S>

Unconditionally save files after macro code was applied.  By default,
files are saved only if the C<$FileChanged> variable has been set to 1
within the macro code.

=item B<--knit|-K> ALL|NONE|name1,name2,...

If a file is saved, save/update also listed types of reffiles the file
pulled data from. For the moment, this only makes sense with the
C<PML> backend which supports so called B<knitting>, i.e. a method to
pull certain data from external resources and push it back (with all
changes) to the original position in the resource when saving the
file. This option allows to list the types of resources (in PML the
types are the reference names listed in the PML schema) which should
be saved. Default is C<NONE>. This type of resources does not include
so called secondary files.

=item B<--no-save>

Never ever save any files (this way you may protect your files from
being saved even if applying a macro that modifies them and sets
C<$TredMacro::FileChanged> to 1).

=item B<--allow-no-trees|-0>

Allow files with no trees (normaly such files are considered broken).
Note: the short flag is -zero.

=item B<--allow-switch-context>

By default, SwitchContext() macro in btred is a no-op.

If this flag is used, SwitchContext() operates as in TrEd, i.e.  it
changes the macro context and calls allow_switch_context_hook,
pre_switch_context_hook, and switch_context_hook appropriately.

=item B<--safe-mode|-F>

Run macro code in a safe compartment restricting some operations that
could be used by a malicious code writer to explore and compromise the
user's environment and potentially the entire system. Most notably,
this blocks most IO operations. NO WARRANTY! If unsure, do not run the
macro code at all.

=item B<--obey-locks>

If used, btred will refuse to open or overwrite a file that is locked
by TrEd.

=item B<--csts-tree-attributes|-X> gov,ord?,hide?

CSTS format is "many in one"; there may be more tree structures in one
file.  This option can be used to specify which tree structure should
be used.  Provide a comma separated list consisting of names of node
atributes corresponding to CSTS elements that contain the necessary
information to build a tree out of a CSTS file. The first attribute
should be an attribute containing the index of the governing node; the
second one is optional and specifies the ordering attribute; the third
one is also optional and if specified, it should be the attribute used
to mark hidden nodes with the string 'hide'. If the third argument is
specified as empty (i.e. there is a trailing comma), default to
'X_hide' with preset-value 'hide'. 

Examples: 
  -X govTR,dord  - corresponds to elements <TRg> and <tfr>
                   in CSTS

  -X govMD_c,ord,x_MD_c_hide 
                 - corresponds to <MDg src="c">, <r>, 
                   and <x name="MD_c_hide">).

=item B<--tectogrammatical-trees|-R>

Build tectogrammatic trees from CSTS files.

=item B<--fs2csts-attributes|-x> list

Comma separated list of FS attribute names that
should be preserved as <x> elements when saving to CSTS.

=item B<--confing-file|-c> filename

Use a given TrEd configuration file.

=item B<--preload-files|-P>

Preload all given files into memory before applying the macros (DOES
NOT WORK WITH RESTRICTED MODE).

=item B<--warn-only|-W>

Do not stop (die) on errors, just warn.

=item B<--validate-fs|-V>

Force Treex::PML to test validity of values assigned to @L (list)
attributes in FS files.

=item B<--quiet|-q>

Print only general processing information on stderr.

=item B<--very-quiet|-Q>

Do not print anything to stderr at all (except for fatal errors).

=item B<--debugging|-D>

Print a lot of debugging information on the stderr.

=item B<--carp>

Replace 'die' with 'Carp::confess', so that a complete stack trace is
printed upon error. Useful for debugging.

=item B<--dump-macros>

Dump all macros currently being loaded to STDOUT and exit. Useful for debugging.

=item B<--server-port|-L> port

Start btred server, listening on a given port; implies -P. Use a
suitable client such as B<ntred> to apply a macro code on the files
possesed by the server.

=item B<--allow-host|-b> hostname

Accept only connections from a given host when operating in the
server-mode.

=item B<--extra-backends|-B> backends

Comma separated list of user-defined IO-backend modules to load.

=item B<--define-symbol|-y> symbol

Symbol name or a name=value pair to be used by macro-preprocessor
(equivalent to a C<#define> instruction at the beginning of the macro
file). Multiple definitions symbols may be separated by a comma and
the option may be repeated.

=item B<--no-secondary-files|-Y>

Neither load or save "secondary" files. Normally, secondary files (if
loaded) are saved along with their primary files (the exactly same
file-name prefix/suffix processing and format apply to both the
primary and secondary files). A secondary file is a file required by a
(normal - primary) file to be loaded along with it; this is typical
for files containing some form of a stand-off annotation where one
tree is built upon another. Note however, that this does not include so
called knitting - an operation where the stand-off annotation is
handled by a IO backend and the resulting knitted file appears to
btred as a single unit.

=item B<--enable-extensions|-j> list

Give a comma-separated list of installed TrEd extension names to
temporarily enable if disabled in the extension configuration.
Use '*' to enable all currently enabled extensions.

=item B<--disable-extensions|-J> list

Give a comma-separated list of installed TrEd extension names to
temporarily disable if enabled in the extension configuration.
Use '*' to disable all currently enabled extensions.

=item B<--list-extensions>

Print out a list of available extensions and exit. Each extension name
is given on a separate line and disabled extensions are preceded by
'!'. This command takes into account options of
B<--disable-extensions> and B<--enable-extensions>, so it can be used
to test their interaction.

=item B<--lib>

Prints path to module directory containing Treex::PML and other TrEd specific
libraries and exit.


=item B<--usage|-u>

Print a brief help message on usage and exits.

=item B<--help|-h>

Prints the help page and exits.

=item B<--man>

Displays the help as manual page.

=back

=head1 LICENSE

This software is distributed under GPL - The General Public Licence.
Full text of the GPL can be found in the LICENSE file distributed with
this program and also on-line at http://www.gnu.org/copyleft/gpl.html.

=head1 AUTHOR

Petr Pajas <pajas@matfyz.cz>

Copyright 2000-2008 Petr Pajas, All rights reserved.

=cut
