package Zion::Zwgc;

use vars qw( @ISA @EXPORT @EXPORT_OK $VERSION $DATE $Debug );

use Exporter;
@ISA = qw( Exporter );

use Carp;
use FileHandle;

$VERSION = '0.41';
$DATE = '<08sep1996>';

@EXPORT    = qw();
@EXPORT_OK = qw( protect substitute );

# Stuff for useful ZWGC support.

# zephyr_variables(FILENAME) -- returns a hash of variables read from FILENAME
sub zephyr_variables {
  carp "Zion::Zwgc::zephyr_variables\n" if $Debug;
  my $name = shift || "$ENV{'HOME'}/.zephyr.vars";
  my $fh = new FileHandle $name;
  my (@data);
  local($_);

  while (<$fh>) {
    chop;
    push( @data, split(/ = /, $_, 2) );
  }
  @data;
}

# All functions below behave more or less equivalently as their ZWGC
# counterparts.  I could document them, but you can just RTFM instead.
# Known differences will be documented here, and in the POD when I get
# around to writing it.  This is, after all, still in alpha.

# POSSIBLE DIFFERENCES (aka, I'm not sure how it works in zwgc):
#  * substitute('$1AAA') maps to "$field[0]AAA", not "${1AAA}".

sub substitute {
  carp "Zion::Zwgc::substitute\n" if $Debug;
  package main;  # we want to look up variables as $main::var; @_ stays same
  my ($subst) = @_;
  my (@fields) = Zion::fields();  # don't trust in @main::fields
  $subst =~ s/\$(\d+)/$fields[$1-1]/eg;
  $subst =~ s/(\$[a-zA-Z0-9_]+)/$1/eeg;
  $subst;
}

use vars qw( %verb %otherside );
%verb = ( '(' => '@<(>', ')' => '@<)>', '<' => '@[<]', '>' => '@[>]',
	  '[' => '@{[}', ']' => '@{]}', '{' => '@({)', '}' => '@(})',
	  '@' => '@(@)' );
sub verbatim {
  carp "Zion::Zwgc::verbatim\n" if $Debug;
  my ($verb) = @_;
  $verb =~ s/([\Q()<>[]{}@\E])/$verb{$1}/eg;
  $verb;
}

%otherside = ( '(' => ')', '<' => '>', '[' => ']', '{' => '}' );
sub protect {
  carp "Zion::Zwgc::protect\n" if $Debug;
  local ($_) = @_;
  my ($prot, @close) = ('', '');
  my ($l, $m, $r);

 SPECIAL:
  while (/[\Q()<>[]{}@\E]/) {
    ($l, $m, $_) = ($`, $&, $');  #'
    $prot .= $l;
    ($m eq $close[0]) && ($prot .= $m, pop(@close), next SPECIAL);
    ($m ne '@') &&       ($prot .= $verb{$m}, next SPECIAL);
    (/^\w*([\Q(<[{\E])/) && ($prot .= "\@$&", $_ = $',   #'
			     push(@close, $otherside{$1}), next SPECIAL);
    # $prot .= $verb{'@'};
    $prot .= '@';
  }
  $prot . $_ . join("", @close);   
}

# The following functions are mostly useless, except in exact
# implementation of particular zwgc.desc language features.  You should be
# able to write better code in perl; but the zwgc2zion translator doesn't
# know about that yet.  PLEASE DON'T WRITE CODE THAT USES THEM.

sub any {
  carp "Zion::Zwgc::any\n" if $Debug;
  my ($arg) = shift;
  my ($val) = ( ref($arg) ? $$arg : $arg );
  my ($ret) = substr($val, @_);
  substr($$arg, @_) = '' if ref($arg);
  $ret;
}

sub break {
  carp "Zion::Zwgc::break\n" if $Debug;
  my ($arg, $pre, $chars, $post) = @_;
  $$arg =~ s/$pre([^\Q$chars\E]*)$post//;
  $1;
}

sub span {
  carp "Zion::Zwgc::span\n" if $Debug;
  my ($arg, $pre, $chars, $post) = @_;
  $$arg =~ s/$pre([\Q$chars\E]*)$post//;
  $1;
}

1;