#!/usr/local/bin/perl5.00502 -w
# Copyright (c) 1999                            RIPE NCC
#
# All Rights Reserved
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted,
# provided that the above copyright notice appear in all copies and that
# both that copyright notice and this permission notice appear in
# supporting documentation, and that the name of the author not be
# used in advertising or publicity pertaining to distribution of the
# software without specific, written prior permission.
#
# THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS; IN NO EVENT SHALL
# AUTHOR BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
# DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN
# AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

#------------------------------------------------------------------------------
# Module Header
# Filename          : Standard Template Tool
# Purpose           : 
# Author            : Originally by Daniel Karrenberg <dfk@ripe.net>
#					  Completely re-written by Timur Bakeyev <timur@ripe.net>
# Date              : 19990707
# Description       : 
# Language Version  : perl5.00502
# OSs Tested        : BSDI 3.1
# Command Line      : Run program without parameters to get list of available
#					 flags
# Input Files       : *.stt within the $STTPATH
# Output Files      : 
# External Programs : mh
# Problems          :
# To Do             : Split text and code parts into files?
# Comments          : Takes notable time to start...
# Version           : $Id: stt.pl,v 1.38 2000/08/14 15:52:08 timur Exp $
#------------------------------------------------------------------------------

package STT;

use strict;

use vars (
    '@ASK',	# ASK - array of references to variables, that should be prompted to input
    '@ARG',	# ARG - array of references to variables, that should be taken from command line
    '@RPL',	# RPL - array of references to variables, that should be taken from original message
    '@STTPATH',	# STTPATH - array of directory names, where STTs reside
    );

use vars (
    '%CMD',	# CMD - hash with available commands and corresponding subroutins
    '%FORM',	# FORM - hash of form properties
    '%OTEXT',	# OTEXT - hash of conditions for variables
    '%OPT',	# OPT - hash with command line switches
    '%BUILTIN',	# BUILTIN - hash with predefined variables
    '%ADDRHEADERS', # ADDRHEADERS - mail headers treated address
    '%PROTECTED',	# PROTECTED - hash with 
    '%VAR',	# VAR is a complex hash of hashes, that containes properties of 
		# each declared variable. Properties are:
		# NAME		- name of the variavle
		# DEFAULT	- default value of the variable
		# REPLY		- name of the mail header filed, from which to derive 
		# 		variables value
		# DESC		- description of the variable, used as a prompt string
		# SELECT	- anon. array, containing list of possible choices, from
		#		which variable can get its value
		# VALUE		- a resulting value of the variable
		# PROTECTED	- a list of protected directories
    );

use vars (
    '$STTFILE',	# STTFILE - full name of the template in process
    '$VER',	# VER - current version
    '$DIGEST',	# DIGEST - MD5 digest of STT
    );

# configurable parameters
use vars qw($PROTECT $STDPATH $TMPDIR $MAILDIR $WARNINGS $CONFIG);

# To be sure indexes start from 0
$[ = 0;

# To get command line arguments
use Getopt::Long;
# To get hostname in a portable way
use Sys::Hostname;
# To get STT checksum
use Digest::MD5;
# To extract path, filename and extension
use File::Basename;
# To compare files
use File::Compare;
# To copy/move files across file systems
use File::Copy;
# To deal with mails, extract headers
use Mail::Internet;
# Mail address parsing
use Mail::Address;
# To read mbox files
use Mail::Util qw(read_mbox);
# To get current working directory
use PathUtils qw(AbsolutePath);

# Default STT version is 1.00
$VER = 100; 
# Default STT search path
$STDPATH = "/ncc/stt2:/home/hostmaster/stt2";
# Directory for keeping temporary results
$TMPDIR = "/tmp";
# Directory, where user's system mailbox resides
$MAILDIR = "/ncc/mail";
# Dirty hack to disable warnings with some STTs
$WARNINGS = 1;
# Location of the configuration file (optional)
$CONFIG = "/etc/stt.conf";

# Debug level
my $debug = 0;
# Shall we reply on existing message or create new one?
my $reply_mode = 1; # Special case for %OPT - 2 switches :(

# Filename extensions for tempate and it's code part
my ($STT, $CODE) = ("stt", "code");
# Available mail box formats
my (%MBOXTYPES) = ( 'MH' => 1, 'MBOX' => 1);
# Available mailers
my (%MAILERS) = ( 'MH' => 1, 'MBOX' => 1);
# Default mail box format, mailer, folder, message and were they changed?
my ($MBOXTYPE, $MAILER, $CURFOLDER, $CURMESSAGE, $CHFLDR) = ("MH", "MH", "+inbox", "cur", 0);
# List of the groups of the authoriative editors :)
my (@OPS) = qw(wheel sttcode);

# Signal handlers. Name of the signal => signal handler
%SIG = (
    'HUP'		=>	\&OnSignal,
    'INT'		=>	\&OnSignal,
    'QUIT'		=>	\&OnSignal,
    'ABRT'		=>	\&OnSignal,
    'TERM'		=>	\&OnSignal,
    'USR1'		=>	\&OnSignal,
    'USR2'		=>	\&OnSignal,
);

# Preset variables. Name of the variable => it's value, probably, runtime evaluated.
%BUILTIN = (
    'logname'		=>	(getpwuid($<))[0],
    'myname'		=>	(getpwuid($<))[6],
    'signame'		=>	$ENV{'SIGNAME'},
    'username'		=>	$ENV{'USERNAME'} ? $ENV{'USERNAME'} : 
				$ENV{'USER'} ? $ENV{'USER'} : (getpwuid($<))[0],
    'hostname'		=>	hostname(),
);
    
# Headers, that contain addresses. Address fields.
%ADDRHEADERS = (
    'from'		=>	'from',
    'reply-to'		=>	'reply-to',
    'sender'		=>	'sender',
    'resent-from'	=>	'resent-from',
    'resent-reply-to'	=>	'resent-reply-to',
    'resent-sender'	=>	'resent-sender',
    'to'		=>	'to',
    'cc'		=>	'cc',
    'bcc'		=>	'bcc',
    'resent-to'		=>	'resent-to',
    'resent-cc'		=>	'resent-cc',
    'resent-bcc'	=>	'resent-bcc',
);

# Available commands. Name of the command => function, that implements it.
%CMD = (
    'ARGS'		=>	\&ARGS,
    'ASK'		=>	\&ASK,
    'CODE'		=>	\&CODE,
    'CODEFINAL'		=>	\&CODEFINAL,
    'CODEINIT'		=>	\&CODEINIT,
    'DEFAULT'		=>	\&DEFAULT,
    'DERIV'		=>	\&DERIV,
    'DESCR'		=>	\&DESCR,
    'OTEXT'		=>	\&OTEXT,
    'OTEXTCOND'		=>	\&OTEXTCOND,
    'POSTSENT'		=>	\&POSTSENT,    
    'POSTNOTSENT'	=>	\&POSTNOTSENT,
    'PRO'		=>	\&PRO,
    'REM'		=>	\&REM,
    'SELECT'		=>	\&SELECT,
    'TEMPLATE'		=>	\&TEMPLATE,
    'TITLE'		=>	\&TITLE,
    'VAR'		=>	\&VAR,
    'VARMULTI'		=>	\&VARMULTI,
    'VERSION'		=>	\&VERSION,
);

# Formats, that shouldn't be editable by common users (see %OPS).
# Command => level of forbiddeness.
my %FORBIDDEN = (
    'CODE'		=>	1,
    'CODEFINAL'		=>	1,
    'CODEINIT'		=>	1,
    'DERIV'		=>	1,
    'OTEXT'		=>	2,
    'OTEXTCOND'		=>	1,
    'POSTSENT'		=>	1,
    'POSTNOTSENT'	=>	1,
);

# CVS/RCS keywords, that are expanded during ci/co. Need to be excluded..
my %KEYWORDS = (
    'Author'		=>	1,
    'Date'		=>	1,
    'Header'		=>	1,
    'Id'		=>	1,
    'Name'		=>	1,
    'Locker'		=>	1,
    'Log'		=>	1,
    'RCSfile'		=>	1,
    'Revision'		=>	1,
    'Source'		=>	1,
    'State'		=>	1,
);

# List of command line options
my @CMDLINE = (
    'create',		# 
    'edit',		# Edit stt-template
    'grep=s',		# Look for template containing 's'
    'list',		# List all available stt-templates
    'new',		# Create a new stt-template from builtin
    'prompt',		# Enforce prompting all variables
    'respond',		# 
    'strict',		# Turn on all possible warnings
    'dump',		# Dump generated program to STDERR
    'sign',		# Calculate MD5 checksum for template
    'sttpath=s',	# Override search path for templates
    'syntax:s',		# Check syntax of specifieds or all templates
    'folder=s',		# Specify alternative folder
    'mailbox=s',	# Specify alternative mailbox
    'mailer=s'		# Specify alternative mailer
);

# Getopt configuration
Getopt::Long::Configure("no_getopt_compat", "prefix_pattern=(--|-)", "require_order", "auto_abbrev");

#
# Main block
#

# Securing our environment
#delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
#$ENV{'PATH'} = "/bin:/usr/bin:/usr/local/bin";

# Get command line argiments
if($#ARGV < 0 || !GetOptions(\%OPT, @CMDLINE))
    {
    Usage();
    }

# Read configuration file. Get updated values for
# $STDPATH, $TMPDIR, $MAILDIR and %PROTECTED
ReadConf();

# Specify mail box format
if(defined($OPT{'mailbox'}))
    {
    my $type = uc($OPT{'mailbox'});
    
    if(defined($MBOXTYPES{$type}))
	{
	$MBOXTYPE = $type;
	}
    else
	{
	GiveUp("Unknown mail box format \"$type\"!");
	}
    }

# Specify mailer
if(defined($OPT{'mailer'}))
    {
    my $type = uc($OPT{'mailer'});
    
    if(defined($MAILERS{$type}))
	{
	$MAILER = $type;
	}
    else
	{
	GiveUp("Unknown mailer \"$type\"!");
	}
    }

# If both flags specified, 'respond' will take the effect
if(defined($OPT{'respond'}))
    {
    $reply_mode = 1;
    }
# Create new message
elsif(defined($OPT{'create'}))
    {
    $reply_mode =  0;
    }

# Specify (optional) folder and number of the message
if(defined($OPT{'folder'}))
    {
    ($CURFOLDER, $CURMESSAGE) = split(/:/, $OPT{'folder'});
    $CHFLDR = 1;
    }
else # Compatability stuff with STT1.00/MH
    {
    if($MBOXTYPE eq 'MH')
	{
	if($#ARGV >= 2 && $ARGV[0] =~ /^\+/)
	    {
	    $CURFOLDER = shift(@ARGV);
	    $CURMESSAGE = shift(@ARGV);
	    $CHFLDR = 1;
	    }
	}
    }

# Configure the search path
@STTPATH = GetSttPath($OPT{'sttpath'});

# List all STTs
if(defined($OPT{'list'}))
    {
    ListStt();
    exit(0);
    }
# Check syntax of all/named template(s)
elsif(defined($OPT{'syntax'}))
    {
    CheckStt($OPT{'syntax'});
    exit(0);
    }

# Try to get filename by looking for a file, containing pattern
# Only if exactly 1 file matches it returns...
if(defined($OPT{'grep'}))
    {
    $STTFILE = GrepStt($OPT{'grep'});
    }
else 
    {
    # At last, get the name of the template....
    $STTFILE = shift(@ARGV) || Usage();
    }

# Create new STT from bundled template. It'll be placed in 
# the first directory from the search path.
if(defined($OPT{'new'}))
    {
    NewStt($STTFILE);
    exit(0);
    }

# Probably, path is absolute, and no need to search
$STTFILE = FindStt($STTFILE) unless(-f $STTFILE);

# Now $STTFILE contains full name

# Open it for editing, if required
if(defined($OPT{'edit'}))
    {
    EditStt($STTFILE);
    exit(0);
    }
# Sign STT with checksum
elsif(defined($OPT{'sign'}))
    {
    my $digest;

    print "Calculating checksum...\n";
    $digest = Checksum($STTFILE);
    print "$digest $STTFILE\n";
    exit(0);
    }

# Main job here
open(STT, "<$STTFILE") || GiveUp("Can't open file $STTFILE: $!");

while(<STT>)
    {
    Parser(\*STT);
    }

close(STT);

if($DIGEST)
    {
    my $digest = Checksum($STTFILE);
    
    GiveUp("Failed checksum: $digest != $DIGEST.\n"
	. "Please, consider to use stt -e \"form\"") if($digest ne $DIGEST);
    }

# Setup necessary vars..
InitVars();

# Prepare and send message. Use return value of 
# the function as exit status.
exit(MakeMessage());

####################################################################
#  DESCRIPTION: Parses file for variables/code declaration
#        INPUT: File handle
#       OUTPUT: None
# SIDE EFFECTS: Initialize %VAR, %FORM, %OTEXT, @ARG, @ASK, @RPL
#		and moves current position in the file
####################################################################
sub Parser
{
my($hdl) = @_; # File handle

    Debug("$_", 2);

    # Look for the //CMD params
    if(m%^//(\w+)\s+(.*)$%)
	{
	# If command is known, execute corresponding subroutine 
	if(defined($CMD{$1}))
	    {
	    $CMD{$1}->($2, $hdl); # indirect function call
	    }
	else
	    {
	    SyntaxError("Unknown format specificator \"$1\"");
	    }
	}
}

####################################################################
#  DESCRIPTION: A set of subroutunes, that perform various aspects
#		of variables and code declaration
#        INPUT: Parameters for format, file handle
#       OUTPUT: None
# SIDE EFFECTS: Current possition in the file can be moved.
#		Initialize global hashes and arrays.
####################################################################

####################################################################
#  DESCRIPTION: Implements ARGS command. Collects names of the vari-
#		ables, that can be initialized from the command line. 
#        INPUT: Space separated list of variables, that will be ini-
#		tialized from command line, file handle
#       OUTPUT: None
# SIDE EFFECTS: With ver 1.00 can create new element of %VAR, if does
#		not exist already.
#       SYNTAX:	ARGS var1 var2 ...
####################################################################
sub ARGS
{
my($cmdline, $hdl) = @_;
my($arg);

    Debug('ARGS', 4);
    foreach $arg (split('\s+', $cmdline))
	{
	if(not defined($VAR{$arg}))
	    {
	    if($VER > 100)
		{
		SyntaxError("Variable \"$arg\" is not declared!");
		}
	    else
		{
		# Fall back case, to be compatiable with old stt
		Warning("Variable \"$arg\" is not declared!");
		$VAR{$arg} = { 'NAME' => $arg };
		}
	    }
	push(@ARG, $VAR{$arg});
	}
}

####################################################################
#  DESCRIPTION: Implements ASK command. Collects names of the vari-
#		ables, that can be initialized via user's input.
#        INPUT: Space separated list of variables, that will be ini-
#		tialized interactively, file handle
#       OUTPUT: None
# SIDE EFFECTS: With ver 1.00 can create new element of %VAR, if does
#		not exist already.
#       SYNTAX:	ASK var1 var2 ...
####################################################################
sub ASK
{
my($cmdline, $hdl) = @_;
my($arg);

    Debug('ASK', 4);
    foreach $arg (split('\s+', $cmdline))
	{
	if(not defined($VAR{$arg}))
	    {
	    if($VER > 100)
		{
		SyntaxError("Variable \"$arg\" is not declared!");
		}
	    else
		{
		# Fall back case, to be compatiable with old stt
		Warning("Variable \"$arg\" is not declared!");
		$VAR{$arg} = { 'NAME' => $arg };
		}
	    }
	push(@ASK, $VAR{$arg});
	}
}

####################################################################
#  DESCRIPTION: Implements CODE command. Gets a piece of perl code, 
#		which should be inserted directly into resulting STT
#		at the early begining code
#        INPUT: undef, file handle
#       OUTPUT: None
# SIDE EFFECTS: Changes current position in the file
#       SYNTAX:	CODE /*
####################################################################
sub CODE
{
my($cmdline, $hdl) = @_;

    Debug('CODE', 4);

    if(not defined($FORM{'CODE'}))
	{
	$FORM{'CODE'} = QuoteCode(scalar(ReadForm($hdl)));
	}
    else
	{
	SyntaxError("Attempt to redefine existing //CODE!");
	}

}

####################################################################
#  DESCRIPTION: Implements CODEFINAL command. Gets a piece of perl 
#		code, which should be inserted directly into result-
#		ing STT after ttemplate variable expansion
#        INPUT: undef, file handle
#       OUTPUT: None
# SIDE EFFECTS: Changes current position in the file
#       SYNTAX:	CODEFINAL /*
####################################################################
sub CODEFINAL
{
my($cmdline, $hdl) = @_;

    Debug('CODEFINAL', 4);

    if(not defined($FORM{'CODEFINAL'}))
	{
	$FORM{'CODEFINAL'} = QuoteCode(scalar(ReadForm($hdl)));
	}
    else
	{
	SyntaxError("Attempt to redefine existing //CODEFINAL!");
	}

}

####################################################################
#  DESCRIPTION: Implements CODEINIT command. Gets a piece of perl 
#		code, which should be inserted directly into result-
#		ing STT at the early begining code
#        INPUT: undef, file handle
#       OUTPUT: None
# SIDE EFFECTS: Changes current position in the file
#       SYNTAX:	CODEINIT /*
####################################################################
sub CODEINIT
{
my($cmdline, $hdl) = @_;

    Debug('CODEINIT', 4);

    if(not defined($FORM{'CODEINIT'}))
	{
	$FORM{'CODEINIT'} =  QuoteCode(scalar(ReadForm($hdl)));
	}
    else
	{
	SyntaxError("Attempt to redefine existing //CODEINIT!");
	}

}

####################################################################
#  DESCRIPTION: Implements DEFAULT command. Sets default behaviuor
#        INPUT: Default parameters (only -c meaningful), file handle
#       OUTPUT: None
# SIDE EFFECTS: None
#       SYNTAX:	DEFAULT [-c]
####################################################################
sub DEFAULT
{
my($cmdline, $hdl) = @_;

    Debug('DEFAULT', 4);
    if($cmdline =~ m%^-c$%)
	{
	# So, command line option still prefered...
	$reply_mode = 0 unless($OPT{'respond'});
	}
}

####################################################################
#  DESCRIPTION: Implements DERIV command. Gets a piece of perl code,
#		which should be inserted directly into resulting STT
#		code
#        INPUT: undef, file handle
#       OUTPUT: None
# SIDE EFFECTS: Changes current position in the file
#       SYNTAX:	DERIV /*
####################################################################
sub DERIV
{
my($cmdline, $hdl) = @_;

    Debug('DERIV', 4);
    SyntaxError("Usage of //DERIV is deprecated! Use //CODE instead,\n"
	. "to reference to corresponding \.${CODE} file.") if($VER > 200);

    if(not defined($FORM{'DERIV'}))
	{
	$FORM{'DERIV'} =  QuoteCode(scalar(ReadForm($hdl)));
	}
    else
	{
	SyntaxError("Attempt to redefine existing //DERIV!");
	}

}

####################################################################
#  DESCRIPTION: Implements OTEXT command. Makes correspondence bet-
#		ween variable name, arbitary text and a condition,
#		on which it decides to assign text to the varaible
#		or not.
#        INPUT: name of the variable and condition, space separated,
#		file handle
#       OUTPUT: None
# SIDE EFFECTS: Changes current position in the file
#       SYNTAX:	OTEXT var condition /*
####################################################################
sub OTEXT
{
my($cmdline, $hdl) = @_;

    Debug('OTEXT', 4);
    SyntaxError("Usage of //OTEXT is deprecated! Use //OTEXTCOND with\n"
	. "corresponding variable declaration.") if($VER > 100);
    
    if($cmdline =~ m%(\w+)\s+(.*)%)
	{
	if(not defined($OTEXT{$1}))
	    {
	    $OTEXT{$1} = QuoteCode($2); # Put condition into the hash
	    }
	else
	    {
	    SyntaxError("Attempt to redefine existing //OTEXT \"$1\"!");
	    }

	# Variable should be specified first... (Appear in the scope of STT::Template)
	if(not defined($VAR{$1}))
	    {
	    if($VER > 100)
		{
		SyntaxError("Variable \"$1\" requires declaration in a //VAR section!");
		}
	    else
		{
		Warning("Variable \"$1\" requires declaration in a //VAR section!");
		$VAR{$1} = { 'NAME' => $1 };
		}
	    }
	
	$VAR{$1}->{'VALUE'} = QuoteVar(scalar(ReadForm($hdl))) if(defined($VAR{$1}));
	}
    else
	{
	SyntaxError("$_");
	}
}

####################################################################
#  DESCRIPTION: Implements OTEXTCOND command. Makes correspondence 
#		between variable name and a condition, on which it 
#		decides to leave varaible in the scope of the prog-
#		ram or not.
#        INPUT: name of the variable, file handle
#       OUTPUT: None
# SIDE EFFECTS: Changes current position in the file
#       SYNTAX:	OTEXTCOND var /*
####################################################################
sub OTEXTCOND
{
my($cmdline, $hdl) = @_;

    Debug('OTEXTCOND', 4);
    if($cmdline =~ m%(\w+)%)
	{
	if(defined($VAR{$1}))
	    {
	    if(not defined($OTEXT{$1}))
		{
		# Put condition into the hash
		  $OTEXT{$1} = QuoteCode(scalar(ReadForm($hdl)));
		}
	    else
		{
		SyntaxError("Attempt to redefine existing //OTEXTCOND \"$1\"!");
		}
	    }
	else
	    {
	    SyntaxError("Variable \"$1\" requires declaration in a //VAR section!");
	    }
	}
    else
	{
	SyntaxError("$_");
	}
}

####################################################################
#  DESCRIPTION: Implements DESCR command. Just a long description
#		of the STT. Does nothing.
#        INPUT: undef, file handle
#       OUTPUT: None
# SIDE EFFECTS: Changes current position in the file
#       SYNTAX:	DESCR /*
####################################################################
sub DESCR
{
my($cmdline, $hdl) = @_;

    Debug('DESCR', 4);
    if(not defined($FORM{'DESCR'}))
	{
	$FORM{'DESCR'} =  QuoteVar(scalar(ReadForm($hdl)));
	}
    else
	{
	SyntaxError("Attempt to redefine existing //DESCR!");
	}
}

####################################################################
#  DESCRIPTION: Implements POSTSENT command.  Gets a piece of perl 
#		code, which should be inserted directly into resulting 
#		STT code and executed if sending of the message comp-
#		leted sucessfuly.
#        INPUT: undef, file handle
#       OUTPUT: None
# SIDE EFFECTS: Changes current position in the file
#       SYNTAX:	POSTSENT /*
####################################################################
sub POSTSENT
{
my($cmdline, $hdl) = @_;

    Debug('POSTSENT', 4);
    if(not defined($FORM{'POSTSENT'}))
	{
	$FORM{'POSTSENT'} =  QuoteCode(scalar(ReadForm($hdl)));
	}
    else
	{
	SyntaxError("Attempt to redefine existing //POSTSENT!");
	}
}

####################################################################
#  DESCRIPTION: Implements POSTNOTSENT command.  Gets a piece of perl 
#		code, which should be inserted directly into resulting 
#		STT code and executed if sending of the message failed
#        INPUT: undef, file handle
#       OUTPUT: None
# SIDE EFFECTS: Changes current position in the file
#       SYNTAX:	POSTNOTSENT /*
####################################################################
sub POSTNOTSENT
{
my($cmdline, $hdl) = @_;

    Debug('POSTNOTSENT', 4);
    if(not defined($FORM{'POSTNOTSENT'}))
	{
	$FORM{'POSTNOTSENT'} =  QuoteCode(scalar(ReadForm($hdl)));
	}
    else
	{
	SyntaxError("Attempt to redefine existing //POSTNOTSENT!");
	}
}

####################################################################
#  DESCRIPTION: Implements TEMPLATE command. Defines the text of the
#		document template - the main purpose of stt itself.
#        INPUT: undef, file handle
#       OUTPUT: None
# SIDE EFFECTS: Changes current position in the file
#       SYNTAX:	TEMPLATE /*
####################################################################
sub TEMPLATE
{
my($cmdline, $hdl) = @_;

    Debug('TEMPLATE', 4);
    if(not defined($FORM{'TEMPLATE'}))
	{
	$FORM{'TEMPLATE'} = QuoteVar(scalar(ReadForm($hdl)));
	}
    else
	{
	SyntaxError("Attempt to redefine existing //TEMPLATE!");
	}
}

####################################################################
#  DESCRIPTION: Implements TITLE command. Defines one line descrip-
#		tion of the template.
#        INPUT: undef, file handle
#       OUTPUT: None
# SIDE EFFECTS: Changes current position in the file
#       SYNTAX:	TITLE short description
####################################################################
sub TITLE
{
my($cmdline, $hdl) = @_;

    Debug('TITLE', 4);
    if($cmdline =~ m%(.*)%)
	{
	if(not defined($FORM{'TITLE'}))
	    {
	    $FORM{'TITLE'} = $1;
	    }
	else
	    {
	    SyntaxError("Attempt to redefine existing //TITLE!");
	    }
	}
    else # does not match template
	{
	SyntaxError("$_");
	}
}

####################################################################
#  DESCRIPTION: Implements PRO command. Defines a prompt, which will
#		be asked to get a value of the variable interactively
#        INPUT: Variable name and prompt, space separated, file handle
#       OUTPUT: None
# SIDE EFFECTS: None
#       SYNTAX:	PRO var "prompt"
####################################################################
sub PRO
{
my($cmdline, $hdl) = @_;

    Debug('PRO', 4);
    if($cmdline =~ m%([\w]+)\s+\"(.*)\"%)
	{
	if(not defined($VAR{$1}))
	    {
	    if($VER > 100)
		{
		SyntaxError("Variable \"$1\" is not declared!");
		}
	    else
		{
		Warning("Variable \"$1\" is not declared!");
		# Fall back case, to be compatiable with old stt
		$VAR{$1} = { 'NAME' => $1 };
		}
	    }
	$VAR{$1}->{'DESC'} = $2;
	}
    else # does not match template
	{
	SyntaxError("$_");
	}
}

####################################################################
#  DESCRIPTION: Implements REM command. Just a one line comment.
#        INPUT: undef, file handle
#       OUTPUT: None
# SIDE EFFECTS: None
#       SYNTAX:	REM string
####################################################################
sub REM
{
my($cmdline, $hdl) = @_;

    Debug('REM', 4);
    
}

####################################################################
#  DESCRIPTION: Implements SELECT command. Defines a list of choices,
#		which user will have, to select one of them. Each line
#		in the declaration is one line of choice item.
#        INPUT: Variable name and prompt, space separated, file handle
#       OUTPUT: None
# SIDE EFFECTS: None
#       SYNTAX:	SELECT var /*
####################################################################
sub SELECT
{
my($cmdline, $hdl) = @_;

    Debug('SELECT', 4);
    if($cmdline =~ m%([\w]+)%)
	{
	my($i, @choices);
	
	if(not defined($VAR{$1}))
	    {
	    SyntaxError("Variable \"$1\" is not declared!");
	    }
	
	@choices = ReadForm($hdl);
	
	# Remove "\n" at the end of each line...
	chomp(@choices);
	
	# Kill empty lines... 
	for($i=0; $i < scalar(@choices); $i++)
	    {
	    # Quote line by line...
	    $choices[$i] = QuoteVar($choices[$i]);
	    # Remove current element and step back - new one at the same place
	    splice(@choices, $i--, 1) if($choices[$i] =~ m%^\s*$%);
	    }
	
	$VAR{$1}->{'SELECT'} = \@choices;
	}
    else # does not match template
	{
	SyntaxError("$_");
	}
}

####################################################################
#  DESCRIPTION: Implements VAR command. Defines new variable in the
#		scope of the template, initializing it by default
#		value and giving ability to derive it from the reply-
#		ing message.
#        INPUT: variable name, how it is derived from the replying
#		message and it's default or built-in value, space 
#		separated; file handle
#       OUTPUT: None
# SIDE EFFECTS: Adds new value to %VAR normaly and complains if it
#		existed before...
#       SYNTAX:	VAR variable "reply-deriv" "default"|"BUILTIN"
####################################################################
sub VAR
{
my($cmdline, $hdl) = @_;

    Debug('VAR', 4);
    if($cmdline =~ m%([\w]+)\s+\"([\S]*?)\"\s+\"(.*?)\"%)
	{
	if(not defined($VAR{$1}))
	    {
	    $VAR{$1} = { 'NAME' => $1 };
	    }
	else
	    {
	    SyntaxError("Variable \"$1\" is already declared!") if($VER > 100);
	    }
	# Already anonymous hash, fill blocks
	
	# Put name of the header field into variable properties
        $VAR{$1}->{'REPLY'} = $2;
	# Set variable defaults, if any
	$VAR{$1}->{'DEFAULT'} = ($3 eq 'BUILTIN' && defined($BUILTIN{$1})) ? $BUILTIN{$1} : $3;
	
	# Also, put a reference to a variable, that derives from
	# mail into list of such variables
	push(@RPL, $VAR{$1}) if($2);
	}
    else # does not match template
	{
	SyntaxError("$_");
	}
}

####################################################################
#  DESCRIPTION: Implements VARMULTY command. Defines new variable in 
#		the scope of the template, initializing it by default
#		value and giving ability to derive it from the reply-
#		ing message. Default value should be multiline test.
#        INPUT: variable name, how it is derived from the replying
#		message; file handle
#       OUTPUT: None
# SIDE EFFECTS: Adds new value to %VAR normaly and complains if it
#		existed before...
#       SYNTAX:	VARMULTI variable "reply-deriv" /*
####################################################################
sub VARMULTI
{
my($cmdline, $hdl) = @_;

    Debug('VARMULTI', 4);
    if($cmdline =~ m%([\w]+)\s+\"([\S]*?)\"%)
	{
	if(not defined($VAR{$1}))
	    {
	    $VAR{$1} = { 'NAME' => $1 };
	    }
	else
	    {
	    SyntaxError("Variable \"$1\" is already declared!") if($VER > 100); 
	    }
	# Already anonymous hash, fill blocks
	
	# Put name of the header field into variable properties
        $VAR{$1}->{'REPLY'} = $2;
	# Set variable defaults, if any
	$VAR{$1}->{'DEFAULT'} =  ReadForm($hdl);
	
	# Also, put a reference to a variable, that derives from
	# mail into list of such variables
	push(@RPL, $VAR{$1}) if($2);
	}
    else # does not match template
	{
	SyntaxError("$_");
	}
}

####################################################################
#  DESCRIPTION: Implements VERSION command. Defines a version of the
#		template and, in addition, MD5 checksum of it.
#        INPUT: Version number and MD5 hash, space separated; file handle
#       OUTPUT: None
# SIDE EFFECTS: Setups $VER and $DIGEST
#       SYNTAX:	VERSION nnn.nn [MD5-digest]
####################################################################
sub VERSION
{
my($cmdline, $hdl) = @_;

    Debug('VERSION', 4);
    if($cmdline =~ m%^(\d+)\.(\d\d)\s*([\da-f]*)\s*$%)
	{
	$VER = int("$1$2");
	$DIGEST = $3 if($3); 
	}
    else
	{
	SyntaxError("Incorrect format of version number \"$cmdline\"");
	}
}

####################################################################
#  DESCRIPTION: Get list of the paths to STT files
#        INPUT: List of the directories, separated by ':' (optional)
#       OUTPUT: Array of accessable directories
# SIDE EFFECTS: None
####################################################################
sub GetSttPath
{    
my($path) = @_;
my(@path, @sttpath);

    unless($path)
	{
	# If environment variable is set, use it, otherwise use $STDPATH
	$path = (defined($ENV{"STTPATH"})) ? $ENV{"STTPATH"} : $STDPATH;
	}

    # Get an array of paths
    @path = split(/[: ]/, $path);

    # Push directory name into the array, if it is accessable
    foreach $path (@path)
	{
	# Make sure dir name has a trailing '/'
	$path =~ s%(.*)/?/?%$1/%;

	push(@sttpath, $path);
	}
	Warning("no STT directory in the path " . join(':', @path)) unless(@sttpath);

return (@sttpath);
}

####################################################################
#  DESCRIPTION: Normalize STT file name - strip extension and path
#		from STT file name
#        INPUT: Name of the STT or CODE file
#       OUTPUT: According to the context: striped name of the STT or
#		array with the name, path and extension.
# SIDE EFFECTS: None
####################################################################
sub NormalizeStt
{
my($file) = @_;
my(@token) = fileparse($file, (".$STT", ".$CODE"));
    
    return (wantarray() ? @token : $token[0]);
}

####################################################################
#  DESCRIPTION: Invoke editor on a given STT file name. If user in 
#		a privileged group - he is able to edit whole temp-
#		late, otherwise - only variable part.
#        INPUT: Full STT filename
#       OUTPUT: None
# SIDE EFFECTS: MD5 checksum wil be added to template
####################################################################
sub EditStt
{
my($file) = @_;
# Get editor name from environment or 'vi' by default
my($editor) = defined($ENV{'EDITOR'}) ? $ENV{'EDITOR'} : 'vi';
# Extract filename and path from given one
my($fname, $fpath) = NormalizeStt($file);
# Get absolute path
my $apath = AbsolutePath($fpath);
# Temporary file name, where shrinked copy will be copied
my $tmpfile = "$TMPDIR/sttedit.$$";
# MD5 checksum
my $ctx = new Digest::MD5;
# Variables
my($str, $verln, $op, $allowed, $lvl, $edfile, $digest, $dir);
my(@path, @stt, @code);

    # Get full name of the template, with path, name and extension
    $file = "${fpath}${fname}\.${STT}";

    # Get copy from repository if any
    REVcheckout($file);

    # If file not readable - give up...
    GiveUp("Can't read file $file") if(! -r $file);
    # We, probably, can write to another file/directory....
    if(not -w $file){ Warning("File \"$file\" is not writable!"); sleep 2; }
    
    # Check, if user in privileged group 
    $op = UserInGroup(@OPS);

    # Get the list of protected directories
    @path = split(/[: ]/, $PROTECT) if($PROTECT);
    
    # Try to obtain absolute path of protected directory
    foreach $dir (@path)
	{
	if($dir)
	    {
	    $dir = AbsolutePath($dir);
	    $PROTECTED{$dir} = $dir;
	    }
	}

    # Check, if user has permissions on code
    # modifications in this directory
    $allowed = ($op || !$PROTECTED{$apath});
    
    # If not, extract allowed part from the file into temporary one
    # and allow to edit it to the user...
    if(not $allowed)
	{
	$digest = Checksum($file);
    
	open(STT, "<$file") || GiveUp("Can't open $file: $!");
	open(TMP, ">$tmpfile") || GiveUp("Can't open $tmpfile: $!");
    
	while($str=<STT>)
	    {
	    # Extract format
	    if($str=~m%^//(\w+)\s+(.*)%)
		{
		# Check against list of forbidden ones
		$lvl = $FORBIDDEN{$1} ? $FORBIDDEN{$1} : 0;

		# We need version number, but also need to find it...
		# Chicken and an egg....
		if($1 eq 'VERSION' && $2 =~ m%^(\d+)\.(\d\d)\s*([\da-f]*)\s*%)
		    {
		    $VER = int("$1$2");
		    if($3)
			{
			$DIGEST = $3;
			
			GiveUp("Failed checksum: $digest != $DIGEST.\n"
			. "Please, call softies to fix the problem!") if($digest ne $DIGEST);
			}
		    }
		
		# According to the level of forbidness and version...
		if($lvl == 1 || ($lvl == 2 && $VER > 100))
		    {
		    push(@code, $str, ReadForm(\*STT), "/*\n");
		    next;
		    }
		}
	    print TMP $str;
	    }

	close(TMP);
	close(STT);
	}
    
    # edit the file
    $edfile = $allowed ? $file : $tmpfile;
    
    # Call editor with passed file name
    # Quote filename, so, it can containe spaces
    system("$editor '$edfile'");
        
    open(STT, "<$edfile") || GiveUp("Can't open $edfile: $!");
    # Suck all the file into array. Yeh, that's stupid :)
    @stt = <STT>;
    close(STT);
    
    # Putting code part back to the template, but, at the bottom...
    for($str=0; $str < scalar(@stt); $str++)
        {
	# Extract format
	if($stt[$str]=~m%^//(\w+)\s+(.*)%)
	    {
	    # Check against list of forbidden ones
	    $lvl = $FORBIDDEN{$1} ? $FORBIDDEN{$1} : 0;
	    
	    # We need version number, but also need to find it...
	    # Chicken and an egg....
	    if($1 eq 'VERSION' && $2 =~ m%^(\d+)\.(\d\d)\s*([\da-f]*)\s*%)
	        {
		$VER = int("$1$2");
		$DIGEST = $3 if($3); # Not necessary
	        $verln = $str;
	        next;
	        }
	
	    # Acording to the level of forbidness and version...
	    if(!$allowed && ($lvl == 1 || ($lvl == 2 && $VER > 100)))
	        {
		
		GiveUp("Code part was found! You have no permissions to add "
		    . "code by yourself! Ask softies to do that!");
		}
	    }
	# Skip all RCS/CVS keywords...
	next if($stt[$str]=~m%\$(\w+)(?:\:.*?)?\$% && $KEYWORDS{$1});

	$ctx->add($stt[$str]);
	}

    # Probably, only not $op has @code....
    if(@code)
	{
        $ctx->add(@code);
        push(@stt, @code);
	}
	
    $digest = $ctx->hexdigest();

    if(defined($verln))
	{
	$stt[$verln] = sprintf("//VERSION %2.02f %s\n", $VER/100, $digest);
	}
    else
	{
	unshift(@stt, sprintf("//VERSION %2.02f %s\n", $VER/100, $digest));
	}
    
    # Everything is ok, file was re-created...
    if(copy($edfile, "$edfile.bak"))
        {
	open(STT, ">$edfile") || GiveUp("Can't open $edfile: $!");
	print STT @stt;
	close(STT);
	
	copy($tmpfile, $file) if(not $allowed);
	
	unlink("$edfile.bak");
	}
	
    # If under revision control - get snap of the changes
    REVcheckin($file);
}

####################################################################
#  DESCRIPTION: Create a new STT from template and invoke editor
#		to edit it.
#        INPUT: STT filename
#       OUTPUT: None
# SIDE EFFECTS: None
####################################################################
sub NewStt
{
my($file) = @_;
# Extract filename and path from given one
my $fname = NormalizeStt($file);

    # Make full path to the file from first directory in the
    # search path, filename and extension
    $file = "${STTPATH[0]}${fname}\.${STT}";
    
    # Give up if file exists
    GiveUp("$file already exists!") if(-f $file);

    umask(0);

    # Copy bundled template into this file
    open(NEW, ">$file") || GiveUp("Failed to create $file: $!");
    
    while(<DATA>)
	{
	print NEW $_;
	}

    close(NEW);

    # Create first entry in revision control system
    REVcreate($file);

    # Invoke an editor
    EditStt($file); 
}

####################################################################
#  DESCRIPTION: Get short description of all STTs, available in the
#		search path
#        INPUT: Path to STTs (optional)
#       OUTPUT: None
# SIDE EFFECTS: None
####################################################################
sub ListStt
{
my(@path) = @_;
my($file, $fname, $dir);

    # If @path empty, set it to @STTPATH, and if it is also
    # empty - get it via call to GetSttPath()
    @path = ((@STTPATH) ? @STTPATH : GetSttPath()) unless(@path);

    foreach $dir (@path)
	{
	if(opendir(STTDIR, $dir))
	    {
	    Debug("Current working directory is $dir", 5);
	    
	    # Where we are now
	    print "$dir:\n";
	    
	    while($file=readdir(STTDIR))
		{
		next unless($file =~ m%.+\.${STT}$%);

		# If file has $STT extension and we able to open it...
		if(open(STT, "<${dir}${file}"))
		    {
		    # Get name and path to the file
		    $fname = NormalizeStt($file);

		    while(<STT>)
			{
			# Get //TITLE string...
			if(m%^//TITLE\s+(.*)$%)
			    {
			    printf("%-16.16s - %s\n", $fname, $1);
			    last;
			    }
			}
		    close(STT);
		    }
		}
	    closedir(STTDIR);
	    }
	else # opendir() failed
	    {
	    Warning("Failed opendir($dir): $!");
	    next;
	    }
	}
}

####################################################################
#  DESCRIPTION: Find all STTs, that contain "pattern". Return name
#		of the file, if only one file exactly matches
#        INPUT: Pattern, path to STTs (optional)
#       OUTPUT: Name of the file, if succed
# SIDE EFFECTS: None
####################################################################
sub GrepStt
{
my($pattern, @path) = @_;
my($nmatches) = (0);
my($file, $name, $dir, $olddir);

    # If @path empty, set it to @STTPATH, and if it is also
    # empty - get it via call to GetSttPath()
    @path = ((@STTPATH) ? @STTPATH : GetSttPath()) unless(@path);

    foreach $dir (@path)
	{
	if(opendir(STTDIR, $dir))
	    {
	    Debug("Current working directory is $dir", 5);
	    
	    while($file=readdir(STTDIR))
		{
		next unless($file =~ m%.+\.${STT}$%);

		# If file has $STT extension and we able to open it...
		if(open(STT, "<${dir}${file}"))
		    {
		    my($match, $desc); # Reset results
		    my $fname = NormalizeStt($file);
	    
		    while(<STT>)
			{
			# If match found, keep results
			if(m%$pattern%)
			    {
			    $match = 1;
			    $nmatches++;
			    $name = $file;
			    }
		    
			# Get //TITLE string...
			if(m%^//TITLE\s+(.*)$%)
			    {
			    $desc = $1;
			    }
			
			# If we have enough info about file, skip processing
			last if($match && defined($desc));
			}
		    
		    close(STT);
		
		    # If match found, print info about the file
		    if($match)
			{
			print "$dir:\n" if($dir ne $olddir);
			printf("%-16.16s - %s\n", $fname, $desc);
			}
		    $olddir = $dir; # Keep track of visited directories
		    }
		}
	    closedir(STTDIR);
	    }
	}
    
    # If nothing match - give up
    if($nmatches == 0)
	{
	GiveUp("\"$pattern\": No match");
	}
    elsif($nmatches > 1) # The same if more, than 1 match...
	{
	GiveUp("$nmatches files match the pattern");
	}

return($name);
}

####################################################################
#  DESCRIPTION: Check syntax of all/specified template(s)
#        INPUT: Name of the file (optional)
#       OUTPUT: None
# SIDE EFFECTS: None
####################################################################
sub CheckStt
{
my($name, @path) = @_;
my($file, $dir);
    
    if($name) # If file name was specified...
	{
	# Find path to it, unless it is already full path
	$name = FindStt($name) unless(-f $name);

	DoCheckStt($name);	
	}
    else
	{
	# If @path empty, set it to @STTPATH, and if it is also
	# empty - get it via call to GetSttPath()
	@path = ((@STTPATH) ? @STTPATH : GetSttPath()) unless(@path);
	
	foreach $dir (@path)
	    {
	    if(opendir(STTDIR, $dir))
		{
		Debug("Current working directory is $dir", 5);
		
		# Where we are now
		print "$dir:\n";
	    
		while($file=readdir(STTDIR))
		    {
		    next unless($file =~ m%.+\.${STT}$%);
		    
		    $file = "${dir}${file}";
		    
		    DoCheckStt($file);
		    }
		closedir(STTDIR);	
		}
	    }
	}
}

####################################################################
#  DESCRIPTION: Check syntax of all/specified template(s)
#        INPUT: Name of the file (optional)
#       OUTPUT: None
# SIDE EFFECTS: None
####################################################################
sub DoCheckStt
{
my($file) = @_;

# Preserve global variables
local(@ASK, @ARG, @RPL);
local(%VAR, %FORM, %OTEXT);
local($VER, $DIGEST);
	
    # Default version 2.00 - we are 
    # forcing strict mode
    $VER = 200; 

    # Get name and a path of the file
    my $fname = NormalizeStt($file);
    print STDERR "in ${fname}:\n";

    # if we able to open file...
    if(open(STT, "<$file"))
        {
        # Parse it, using regular parser
        while(<STT>)
    	    {
    	    Parser(\*STT);
    	    }
    
	close(STT);
	}
}
	
####################################################################
#  DESCRIPTION: Looks for STT in the path
#        INPUT: Name of the STT file, search path (optional)
#       OUTPUT: Filename with the path
# SIDE EFFECTS: None
####################################################################
sub FindStt
{
my($file, @path) = @_;
my $fname = NormalizeStt($file);
my $dir;

    # If @path empty, set it to @STTPATH, and if it is also
    # empty - get it via call to GetSttPath()
    @path = ((@STTPATH) ? @STTPATH : GetSttPath()) unless(@path);

    foreach $dir (@path)
	{
	if(opendir(STTDIR, $dir))
	    {
	    Debug("Current working directory is $dir", 5);
	    
	    while($file=readdir(STTDIR))
		{
		next unless($file =~ m%.+\.${STT}$%);

		if($file eq "${fname}\.${STT}")
		    {
		    $file = "${dir}${fname}\.${STT}";
		    return $file;
		    }
		}
	    closedir(STTDIR);
	    }
	}
    # No luck
    GiveUp("Can't find form \"$fname\"!");
}

####################################################################
#  DESCRIPTION: Calculate MD5 hash on a context of STT file, except
#		line, that containes //VERSION string. There we keep
#		calculated checksum.
#        INPUT: STT filename
#       OUTPUT: MD5 hex digest
# SIDE EFFECTS: None
####################################################################
sub Checksum
{
my($file) = @_;
# Checksum context
my $ctx = new Digest::MD5;
my($str, $digest, $chksum);

    open(STT, "<$file") || GiveUp("Can't open $file: $!");

    while($str=<STT>)
	{
	# Extract version and digest from the file
	if($str=~m%^//VERSION\s+(.*)%)
	    {
	    if($1=~m%(\d+\.\d\d)\s*([\da-f]*)\s*%)
		{
		$chksum = $2 if($2);
		}
	    else
		{
		SyntaxError("Incorrect format of version number \"$1\"");
		}
	    }
	elsif($str=~m%\$(\w+)(?:\:.*?)?\$% && $KEYWORDS{$1})
	    {
	    next;
	    }
	else
	    {
	    $ctx->add($str);
	    }
	}

    close(STT);

    $digest = $ctx->hexdigest();

    return wantarray() ? ($digest, $chksum) : $digest;    
}

####################################################################
#  DESCRIPTION: Read STT2 configuration files: $CONFIG(/etc/stt.conf)
#		and $HOME/.sttrc
#        INPUT: None
#       OUTPUT: None
# SIDE EFFECTS: Change values of $STDPATH, $TMPDIR, $MAILDIR and
#		%PROTECTED
####################################################################
sub ReadConf
{
my($file, $name, $value, $dir);
my @config = ($CONFIG);
    
    if(defined($ENV{'HOME'}))
	{
	push(@config, "$ENV{'HOME'}/.sttrc");
	}
    else
	{
	my $home = (getpwuid($<))[7]; # home directory
	push(@config, "$home/.sttrc")
	}

    foreach $file (@config)
	{
	if(open(CONF, $file))
	    {
	    while(<CONF>)
		{
		 chomp;                  # no newline
		 s/#.*//;                # no comments
		 s/^\s+//;               # no leading whitespaces
		 s/\s+$//;               # no trailing whitespaces
		 next unless length;     # anything left?
	    
		if(($name, $value)=m%(\w+)\s*=\s*(.+)%)
		    {
		    if($name eq 'PROTECT' )
			{
			# We are merging values to prevent
			# overriding system config.
			$PROTECT .= ":$value" if($value);
			}
		    elsif($name eq 'STTPATH')
			{
			$STDPATH = $value if($value);
			}
		    elsif($name eq 'TMPDIR')
			{
			$TMPDIR = $value if($value);
			}
		    elsif($name eq 'MAILDIR')
			{
			$MAILDIR = $value if($value);
			}
		    elsif($name eq 'WARNINGS')
			{
			$WARNINGS = ($value =~ m%^(?:no|off|0)$%i) ? 0 : 1;
			}
		    elsif($name eq 'AUTHGROUPS')
			{
			my @ops = grep { $_ } split(/[\s,:;]+/, $value);
			@OPS = @ops if(@ops);
			}
		    else
			{
			GiveUp("$file: $.: Unrecognized pair \"$name=$value\"");
			}
		    }
		else
		    {
		    GiveUp("$file: $.: Unrecognized line \"$_\"");
		    }
		}
	    close(CONF);
	    }
	}
}

####################################################################
#  DESCRIPTION: Read multi-line variable till the terminating sign
#        INPUT: File handle
#       OUTPUT: String or array with the text till terminator (/*)
# SIDE EFFECTS: Moves pointer in the file
####################################################################
sub ReadForm
{
my($hdl) = @_;
my($str, @form);

    while($str=<$hdl>)
	{
	Debug("$str");

	# If terminator - return resulting string
	return wantarray() ? @form : join('', @form) if($str =~ m%^\/\*%);
	
	# Sanity check - in case of unterminated multi-line var other formats
	# can appear inside the text - probably, this is an error...
	Warning("Format specificator //$1 is inside the text. Possibly, missed closing \"/*\" somewhere...") 
		if($str =~ m%^//(\w+)% && defined($CMD{$1}));
	
	push(@form, $str);
	}
}

####################################################################
#  Internal cycle - process all obtained values, get additional
#  ones, if necessary. 
####################################################################

####################################################################
#  DESCRIPTION: Initialize template variables, collecting information
#		from different sources
#        INPUT: None
#       OUTPUT: None
# SIDE EFFECTS: Fills 'VALUE' filed in variable's properties
####################################################################
sub InitVars
{
my($var, $name);

    # Get command line arguments for listed variables
    GetArgs();
    # Get information from replying message 
    MailParse() if($reply_mode);
    # Request manual input for listed variables, if they not defined, still
    AskVars();
    # Add default values, if any
    AddDefaults();
}


####################################################################
#  DESCRIPTION: Gets variables values from command line
#        INPUT: None
#       OUTPUT: None
# SIDE EFFECTS: None
####################################################################
sub GetArgs
{
my($var, $in);

    foreach $var (@ARG)
	{
	last if(not defined($in=shift(@ARGV))); # If no @ARGV - exiting

	# Only if inputed argument isn't empty
	if((!exists($var->{'VALUE'}) || !defined($var->{'VALUE'})) && $in ne '')
	    {
	    $var->{'VALUE'}  = QuoteVar($in);
	    }
	}
}

####################################################################
#  DESCRIPTION: Parses mail, to get values to initialize variables
#        INPUT: None
#       OUTPUT: None
# SIDE EFFECTS: Reads mail from default (specified) folder
####################################################################
sub MailParse
{
# var - reference to a variable properties
# mail - object representation of the mail
# head -  ----""------ of mail's header
# tag - 
# repl, from, reply_to - objects, that correspondes to respective mail header fields
my($var, $mail, $head, $tag, $repl, $from, $reply_to);

# reply - hash with mail header's tags and values
my(%reply);

    # Creat object, that containes prepared message,
    # on which we are replying
    $mail = new Mail::Internet(GetMessage()) || GiveUp("Unable to retrive message");
    
    # Get reference to mail's header
    $head = $mail->head() || GiveUp("There is no header in the message");

    # Unfold all header lines - make them to be one string
    $head->unfold();
    
    # Combine all similar headers into one line
    foreach $tag ($head->tags())
	{
	my($with) = defined($ADDRHEADERS{lc($tag)}) ? ', ' : ' ';
	$head->combine($tag, $with);
	}

    # A string representation of mail header
    $reply{'rfc822-header'} = $head->as_string();
    
    # First available recipient
    $reply{'repl'} = $mail->get('Reply-To')
		    || $mail->get('From')
		    || $mail->get('Return-Path')
		    || $mail->get('Sender')
		    || "(Correspondent)";

    $repl = (Mail::Address->parse($reply{'repl'}))[0];
    
    ($reply{'repl-name'}, $reply{'repl-addr'}) = 
	    ($repl->name(), $repl->address()) if($repl);

    # From
    $reply{'from'} = $mail->get('From');
    $from = (Mail::Address->parse($reply{'from'}))[0];
    
    ($reply{'from-name'}, $reply{'from-addr'}) = 
	    ($from->name(), $from->address()) if($from);
    
    # Reply-To
    $reply{'reply-to'} = $mail->get('Reply-To');
    $reply_to = (Mail::Address->parse($reply{'reply-to'}))[0];
    
    ($reply{'reply-to-name'}, $reply{'reply-to-addr'}) = 
	    ($reply_to->name(), $reply_to->address()) if($reply_to);

    # Convert array of body's strings into a single string.
    $reply{'body'} = join('', '', @{ $mail->body() });
    
    # Walk through the list of variables, that derive from mail header
    foreach $var (@RPL)
	{
	# If var already has value - skip
	next if(exists($var->{'VALUE'}) && defined($var->{'VALUE'}));
	
	# Field probably can contain extra specificators
	my($field, @spec) = split('/', $var->{'REPLY'});
	my($spec);
	
	# If field is not already in the hash, add it
	if(not defined($reply{$field}))
	    {
	    # We need only non-empty headers
	    next unless($reply{$field}=$mail->get($field));
		
	    chomp($reply{$field});
	    }

	# If there are additional specificators to the field, process them
	foreach $spec (@spec)
	    {
	    if($spec =~ m%^(\d+)([BbLl])$% && $1 > 0) # "field/nnnb"
		{
		my($n) = $1;
		if($2 =~ m%B%i) # Get $n bytes from the field
		    {
		    $reply{$field} = substr($reply{$field}, 0, $n);
		    }
		elsif($2 =~ m%L%i) # Get $n lines from the field
		    {
		    my $buf;
		    
		    $buf .= "$1\n" while($n-- > 0 && $reply{$field} =~ m%(^.*$)%mg);
		    $reply{$field} = $buf;
		    }
		}
	    else
		{
		Warning("Unknown specificator \"$spec\"!");
		}
	    }
	    
	# Assign obtained value to the variable, if it's not empty
	$var->{'VALUE'} = QuoteInput($reply{$field}) if($reply{$field});
	}
}

####################################################################
#  DESCRIPTION: Asks variables values interactively
#        INPUT: None
#       OUTPUT: None
# SIDE EFFECTS: None
####################################################################
sub AskVars
{
my($var, $in);

    return unless(-t STDIN); # We are expecting to get info from STDIN
    
    # Walk through the list of variables, that should be asked
    foreach $var (@ASK)
	{
	if($OPT{'prompt'} || !exists($var->{'VALUE'}) || !defined($var->{'VALUE'}))
	    {
	    # If no prompt specified, issue generic one...
	    my $prompt = defined($var->{'DESC'}) ? $var->{'DESC'} : "Variable \$$var->{'NAME'}";
	    # ... and emply default value
	    my $default = defined($var->{'DEFAULT'}) ? $var->{'DEFAULT'} : '';
	    
	    # If we have multichoice variable, give choices to the user and get
	    # one of the possible values
	    if(defined($var->{'SELECT'}))
		{
		# Variable will get one of the possible values...
		$var->{'VALUE'} = QuoteInput(Choice($prompt, $var->{'SELECT'}, $default));
		}
	    else
		{
		# Variable will get either inputed value, or, if no input - default
		# Prompt does quoting for us...
		$var->{'VALUE'} = QuoteInput(Prompt($prompt, $default));
		}
	    }
	}
}

####################################################################
#  DESCRIPTION: Adds default values to variables, that still don't
#		have any...
#        INPUT: None
#       OUTPUT: None
# SIDE EFFECTS: None
####################################################################
sub AddDefaults
{
my($name, $var);

    # Check whole list of existing variables
    while(($name, $var) = each(%VAR))    
	{
	# Skip initialized variables
	next if(exists($var->{'VALUE'}) && defined($var->{'VALUE'}));
	
	if(defined($var->{'DEFAULT'}) && $var->{'DEFAULT'} ne '')
	    {
	    $var->{'VALUE'} = QuoteVar($var->{'DEFAULT'});
	    }
	}
}

####################################################################
#  DESCRIPTION: Prompts for input and returns it
#        INPUT: Prompt string, default value
#       OUTPUT: Inputed string
# SIDE EFFECTS: 
####################################################################
sub GetLine
{
my($prompt, $def) = @_;

    $| = 1;
    # Make default eq empty string, if not provided...
    $def ||= "";
    # If STDIN redirected, try to prompt via STDERR
    print { (-t STDOUT) ? *STDOUT : *STDERR } "$prompt [$def]: ";
    my $in = <STDIN>;
    
    # Remove spaces at the begining/end
    if(defined($in))
	{
	$in =~ s%^\s+%%;
	$in =~ s%\s+$%%;
	}

    $| = 0;

# O is a legal input, so we check, if input defined..
return (defined($in) && length($in) > 0) ? $in : $def;
}

####################################################################
#  DESCRIPTION: Prompts for input and returns inputed or, if no input,
#		default value 
#        INPUT: Prompt string, default value; optional reference to 
#		the validation function
#       OUTPUT: result - input or default
# SIDE EFFECTS: Returned value is quoted
####################################################################
sub Prompt
{
my($prompt, $def, $valid) = @_;

# Init input by the default value
my $input = $def;

    # We do have input validation function
    # It should accept inputed value as parameter
    # and give true, if it is acceptable, else - false
    if(defined($valid) && ref($valid) eq 'CODE')
	{
	do  {
	    $input = GetLine($prompt, $input);
	    } while(not $valid->($input));
	}
    # Just plain old stright version
    else
	{
	$input = GetLine($prompt, $input);
	}

return $input;
}

####################################################################
#  DESCRIPTION: Prompts for input and gives a list of possible choi-
#		ces and returnes selected value from the list
#        INPUT: Prompt string, reference to the array of choices, 
#		default selection
#       OUTPUT: One of the possible values from the list of choices
# SIDE EFFECTS: Quotes returned value
####################################################################
sub Choice
{
my($prompt, $choice, $sel) = @_;
my ($i, $n); 
# Input validation function. Contains reference to the external $n - 
# number of entries. As it's in the same scope, it should be ok...(?)
my $valid = sub { my $sel = shift; return($sel =~ m%^\d+$% && ($sel > 0 && $sel <= $n));};

    # If no default selection use 1
    $sel ||= 1;
    # Size of the array
    $n = scalar(@{$choice});
    
    # If list empty return immediately
    return "" unless($n > 0);
    
    # If STDIN redirected, try to prompt via STDERR
    print { (-t STDOUT) ? *STDOUT : *STDERR } "\n$prompt:\n\n";
    
    for($i=1; $i <= $n; $i++)
	{
	print { (-t STDOUT) ? *STDOUT : *STDERR } "    $i. $choice->[$i-1]\n";
	}
    print { (-t STDOUT) ? *STDOUT : *STDERR } "\n";
    
    $sel = Prompt("Your choice", $sel, $valid);
    
return $choice->[$sel-1];
}

####################################################################
#  Mail handling routines. Get and send mails.
####################################################################

####################################################################
#  DESCRIPTION: Gets message from mailbox
#        INPUT: None
#       OUTPUT: A reference to array with requested message
# SIDE EFFECTS: To guess, what to return uses global variables
#	    	$MBOXTYPE, $CURFOLDER, $CURMESSAGE and $CHFLDR
#		The last is to indicate, that folder was changed
#		from default
####################################################################
sub GetMessage
{	
# mailbox - name of current mailbox or mail - depends from box type
# array - generic array, used to store list information
# mail_ref - referemce to array with requested mail 
my($mailbox, @array, $mail_ref);

    if($MBOXTYPE eq 'MH')
	{
	# If folder was specified - use it
	if($CHFLDR)
	    {
	    # Fix defaults
	    $CURFOLDER = "+inbox" if(not defined($CURFOLDER));
	    $CURMESSAGE = "cur" if(not defined($CURMESSAGE));
	    
	    # Make sure, that folder is name prepended with '+' sign
	    $CURFOLDER =~ s%^([^+].*)$%+$1%;
	    
	    chomp($mailbox=`mhpath $CURFOLDER $CURMESSAGE`);
	    }
	else # Just default current message...
	    {
	    chomp($mailbox=`mhpath cur`);
	    }

	GiveUp("Can't find mailbox \"$mailbox\": $?") if($?);
	
        open(MAIL, "<$mailbox") || GiveUp("Failed to open mailbox \"$mailbox\": $!");
	
	# Read mail into anonymous array
	$mail_ref = [<MAIL>];
	
	close(MAIL);
	}
    elsif($MBOXTYPE eq 'MBOX')
	{
	my($msg);
	
	# Try to guess path to the default user's mailbox
	$mailbox = defined($ENV{'MAIL'}) ? $ENV{'MAIL'} : 
	    $MAILDIR . (defined($ENV{'USER'}) ? $ENV{'USER'} : $BUILTIN{'logname'});

	# If folder was modified...
	if($CHFLDR)
	    {
	    # If path to mailbox was changed...
	    $mailbox = $CURFOLDER if(defined($CURFOLDER));
	    
	    # By default, we get last message from the mailbox
	    # If specified number of the message, get this message
	    $msg = $CURMESSAGE - 1 if(defined($CURMESSAGE) && $CURMESSAGE =~ m%^(\d+)$% && $1 > 0);
	    }

	-r $mailbox || GiveUp("Failed to read mailbox \"$mailbox\": $!");
	
	# Load all messages into array of references to arrays with messages.... :()
	@array = read_mbox($mailbox);
	
	# If specified, get numbered mesage, else - last one
	$mail_ref = defined($msg) ? $array[$msg] : pop(@array);
	}

return($mail_ref);
}

####################################################################
#  DESCRIPTION: Sends message, using current mailer
#        INPUT: Message
#       OUTPUT: 0 on success, error code - otherwise
# SIDE EFFECTS: None
####################################################################
sub SendMessage
{
my($msg) = @_;

    if($MAILER eq 'MH')
	{
	# Which editor to use
	my($editor) = $ENV{"EDITOR"} ? $ENV{"EDITOR"} : 'vi';
	my(@cmd, $retcode);

	open(MSG, ">$TMPDIR/sttmsg.$$") || GiveUp("open $TMPDIR/sttmsg.$$: $!");
	print MSG $msg;
	close(MSG);

	# Collecting command line...
	@cmd = ("comp", "-use", "-file", "$TMPDIR/sttmsg.$$");
 	push(@cmd, "-editor", $editor) if($editor);
	# Run mail system and obtain retcode..
	$retcode = system(@cmd);

	# annotate if reply
	if($reply_mode && $retcode == 0)
	    { 
	    @cmd = ("anno");
	    push(@cmd, $CURFOLDER, $CURMESSAGE) if($CHFLDR);
	    push(@cmd, "-component", "Replied", "-text");
	    push(@cmd, "via STT using form $STTFILE\n" 
		. join("\n", grep(/^[tT]o:\s+\S+|^[cC]c:\s+\S+|^[Bb][Cc]c:\s+\S+/, split(/\n/, $msg))));
	    system(@cmd);
	    }
	unlink("$TMPDIR/sttmsg.$$"); # no check, file might have gone already "q d"
	return($retcode);
	}
    elsif($MAILER eq 'MBOX')
	{
	print $msg;
	return(0);
	}
    else
	{
	GiveUp("Mailer is not implemented yet!");
	}
}

####################################################################
#  Revision control system dependent routines
#  assumptions:
#	- we are in the right dir
#	- we can determine which kind of revision control
#	- revision control system commands in $PATH
####################################################################

####################################################################
#  DESCRIPTION: 
#        INPUT: None
#       OUTPUT: None
# SIDE EFFECTS: None
####################################################################
sub REVcheckout
{
my($file) = @_;


    if (-d "RCS")
	{
	system("co", "-q", "-l", "$file");
	}
}

####################################################################
#  DESCRIPTION: 
#        INPUT: None
#       OUTPUT: None
# SIDE EFFECTS: None
####################################################################
sub REVcheckin
{
my($file) = @_;

    if(-d "RCS")
	{
        system("ci", "-q", "-u", "$file");
	}
}	

####################################################################
#  DESCRIPTION: 
#        INPUT: None
#       OUTPUT: None
# SIDE EFFECTS: None
####################################################################
sub REVcreate
{
my($file) = @_;

    if(-d "RCS")
	{
	system("ci", "-u", "$file");
	}
}


####################################################################
#  DESCRIPTION: Does the final job - gathers all available parts of 
#		STT, generates small Perl5 program and evaluates it
#        INPUT: None
#       OUTPUT: None
# SIDE EFFECTS: All job is done :)
####################################################################
sub MakeMessage
{
my($otext_vars, $otext_code) = ("", "");

# Scalars, where our program coll all necessary parts of program
my $prog = "package STT::Template;\n\n";

    # With old versions of stt skip some sanity chechks...
    # Disable -w
    $^W = 0 if($VER <= 100 || !$WARNINGS);
    #Disable strictness
    $prog .= "no strict;\n\n" if($VER <= 100);

    $prog .= "# Code initialization part\n\n";
    # Put code initialization part at the begining of the progrsmm
    if(defined($FORM{'CODEINIT'}))
	{
	$prog .= $FORM{'CODEINIT'} . ";\n\n";
	}
    
    # Put variables definition...
    $prog .= "# Declare variables\n";
    
    # Get sorted list of all variables
    for my $name (sort(keys(%VAR)))
	{
	# Variable declaration
	$prog .= "my " if($VER > 100);
	$prog .= "\$$name = \"";
	
	# If variable has the value, and it's not conditional...
	if(defined($VAR{$name}->{'VALUE'}) && !defined($OTEXT{$name}))
	    {
	    # Assign that value to it
	    $prog .= $VAR{$name}->{'VALUE'};
	    }
	$prog .= "\";\n";
	}
	    
    $prog .= "\n# Subroutunes declaration\n";
    
    # Pre-defined subroutunes
    $prog .= "sub prompt\n{\nmy(\$prompt, \$def, \$func) = \@_;\n\nSTT::Prompt(\$prompt, \$def, \$func);\n}\n\n";
    $prog .= "sub choice\n{\nmy(\$prompt, \$array, \$def) = \@_;\n\nSTT::Choice(\$prompt, \$array, \$def);\n}\n\n";
    $prog .= "sub mopper\n{\nmy(\$msg) = \@_;\n\nSTT::Warning(\$msg);\n}\n\n";
    $prog .= "sub giveup\n{\nmy(\$msg) = \@_;\n\nSTT::GiveUp(\$msg);\n}\n\n";

    $otext_vars .= "# Conditional text variables\n";
    # Create subroutunes from conditional part of //OTEXT
    for my $name (sort(keys(%OTEXT)))
	{
	# Create a subrotune, that performs condition calculations
	if(defined($OTEXT{$name}))
	    {
	    $prog .= "sub $name\n{\nmy(\$param) = \@_;\n\n" . $OTEXT{$name} . ";\n}\n";
	    }
	else
	    {
	    Warning("Condition for \"$name\" is not defined! Always \"TRUE\" will be used!");
	    $prog .= "sub $name { return 1; }\n";
	    }
	$prog .= "\n";

	if(defined($VAR{$name}->{'VALUE'}))
	    {
	    $otext_vars .= "\$$name = \"" . $VAR{$name}->{'VALUE'} . "\";\n";
	    }
	# We assign empty string to variable, if condition isn't true
	# cause we can't expand undef in template without error message...
	$otext_code .= "\$$name = \"\" unless($name());\n";
	}
    
    $prog .= "# Code derive part\n\n";
    # Put code part into the main cycle of the progrsmm
    if(defined($FORM{'CODE'}))
	{
	$prog .= $FORM{'CODE'} . ";\n\n";
	}

    if(defined($FORM{'DERIV'}))
	{
	# If we also have //CODE declaration, we should blame - they can't
	# coexist - they have the same purpose....
	if(defined($FORM{'CODE'}))
	    {
	    SyntaxError("//CODE and //DERIV can\'t coexist! Choose //CODE, please!")
	    }
	
	# Get rid of //DERIVE in new versions...
	if($VER <= 200)
	    {
	    $prog .= $FORM{'DERIV'} . ";\n\n";
	    }
	else
	    {
	    SyntaxError("Usage of //DERIV is deprecated in this version of format!");
	    }
	}

    # Process OTEXT conditional derivations...
    $prog .= "$otext_vars\n\n$otext_code\n\n# Message body itself\n\n";

    # Declare variable that containes final message
    if(defined($FORM{'TEMPLATE'}))
	{
	$prog .= "my " if($VER > 100);
	$prog .= "\$__FINAL_MESSAGE__ = \"" . $FORM{'TEMPLATE'} . "\";\n\n";
	}
    else
	{
	SyntaxError("No //TEMPLATE defined!");
	}

    $prog .= "# Message postprocessing part\n\n";
    # Post-process template message
    if(defined($FORM{'CODEFINAL'}))
	{
	$prog .= $FORM{'CODEFINAL'} . ";\n\n";
	}

    # Just send message via $MAILER
    $prog .= "if(STT::SendMessage(\$__FINAL_MESSAGE__) == 0)\n{\n";
    
    # If there are postprocessing procedures, include them
    # If sending succees...
    $prog .= $FORM{'POSTSENT'} if(defined($FORM{'POSTSENT'}));
    # Exit with 0, to indicate Ok
    $prog .= ";\nreturn(0);\n}\nelse\n{\n";
    
    # Or, failed...
    $prog .= $FORM{'POSTNOTSENT'} if(defined($FORM{'POSTNOTSENT'}));
    # Exit with -1, to show, that sending failed
    $prog .= ";\nreturn(-1);\n}\n\n";
    
    # Print generated program if --dump specified in command line
    print STDERR $prog if($OPT{'dump'});

    my $ret = eval($prog); #Here is the result of all this code :)

    if($@)
	{
	print STDERR "STT template error, "; 
	if(!open(ERR, ">$TMPDIR/stterror.$$"))
	    {
	    print STDERR "open $TMPDIR/stterror.$$: $!\n";
	    GiveUp("cannot write diagnostics!");
	    }
	print ERR $prog;
	$_ = $@;
	s%in file \(eval\) %%;
	s%\(eval\s*\d*\) %%;
	print ERR "\n---\n$_\n"; 
	print STDERR "\n---\n$_\n"; 
	print STDERR ("Diganostics was written to \"$TMPDIR/stterror.$$\".\n");
	}

    # Return results of evaluation, if any
    return($ret);
}

####################################################################
#  Different internal subroutunes
####################################################################

####################################################################
#  DESCRIPTION: Escapes symbols, that have special meaning in the
#		double quoted string
#        INPUT: String to be escaped
#       OUTPUT: Escaped string
# SIDE EFFECTS: 
####################################################################
sub QuoteVar
{
my($str) = @_;

    $str =~ s%([\@\"\\])%\\$1%g;
    
    return($str);
}
####################################################################
#  DESCRIPTION: Escapes symbols, that have special meaning in the
#		double quoted string
#        INPUT: String to be escaped
#       OUTPUT: Escaped string
# SIDE EFFECTS: 
####################################################################
sub QuoteInput
{
my($str) = @_;

    $str =~ s%([\$\@\"\\])%\\$1%g;
    
    return($str);
}

####################################################################
#  DESCRIPTION: Quotes '@' sign insige the string. Skips already
#		quoted sign.
#        INPUT: String to be escaped
#       OUTPUT: Escaped string
# SIDE EFFECTS: None
####################################################################
sub quote_at
{
my($str) = @_;

    # @ -> \@, and skip already \@ escaped...
    if($str=~ s%(?<!\\)\@%\\\@%g)
	{
	# In fact, usage of "@" is deprecated in Perl5...
	Warning("In string, \"\@string\" now must be written as \"\\\@string\".\nPlease, recheck the code!");
	}

    return ($str);
}
####################################################################
#  DESCRIPTION: Escapes symbols, that have specioa meaning inside 
#		the Perl5 code.
#        INPUT: None
#       OUTPUT: None
# SIDE EFFECTS: None
####################################################################
sub QuoteCode
{
my($str) = @_;

    # Catch and quote @ sign inside "", skipping \"...
    $str =~ s%((?<!\\)".*?(?<!\\)")%quote_at($1)%esg;
    
    return($str);
}

####################################################################
#  DESCRIPTION: Checks, if current user belongs to one of the groups
#		in list.
#        INPUT: List of groups
#       OUTPUT: 1, if user belongs to the list, 0 - otherwise
# SIDE EFFECTS: None
####################################################################
sub UserInGroup
{
my(@ops) = @_;
my($gid);

foreach $gid (split(" ", $( ))
    {
    return 1 if(grep { $gid == getgrnam($_) } @ops);
    }
return 0;
}


####################################################################
#  DESCRIPTION: Reports about syntax error and exits if it is STT2
#		or we are in the 'strict' mode.
#        INPUT: Error message
#       OUTPUT: None
# SIDE EFFECTS: Uses current line number
####################################################################
sub SyntaxError
{
my($msg) = @_;

    chomp($msg);
    print STDERR "Syntax error at line $.: $msg\n";
    GiveUp("Fatal error(s) found!") if($OPT{'strict'} || $VER > 100);
}

####################################################################
#  DESCRIPTION: Shows a warning message with current line number
#        INPUT: Error message
#       OUTPUT: None
# SIDE EFFECTS: None
####################################################################
sub Warning
{
my($msg) = @_;

    chomp($msg);
    print STDERR "Warning at line $.: $msg\n" if($OPT{'strict'} || $VER > 100);
}

####################################################################
#  DESCRIPTION: Shows list of available command line options
#        INPUT: None
#       OUTPUT: None
# SIDE EFFECTS: None
####################################################################
sub Usage
{
    print STDERR <<USAGE;

Usage: stt2 [modifiers] form [formargs ...]
       stt2 [modifiers] (--edit|--new) form [formargs ...]
       stt2 [modifiers] --grep "pattern" [formargs ...]
       stt2 (--list|--syntax [form])
       stt2 --sign form
        
Where options are:

  --edit form			Edit stt template
  --new	 form			Create new STT from build-in template
  --sign form			Calculate MD5 hash of the form
  --grep "pattern"		Find all occurences of "pattern" in STT
                                and open it, if exactly one match
  --list			List all STTs with short description
  --syntax [form]		Check syntax of all STTs or just a "form"

Modifiers can be:

  --create			Create respond from scratch
  --respond			Respond on current mail
  --prompt			Force prompting for all variables
  --strict			Force stoping program on syntax errors
  --dump			Dump generated perl code to STDERR
  --sttpath "PATH"		Override default path(s) to STT files
  --folder [folder][:message]	Take "message" from the "folder"
  --mailbox "FORMAT"		Use "FORMAT" to read mail [MH|MBOX]
  --mailer "MAILER"		Use "MAILER" to send mail [MH|MBOX]

Notes:

  1. Folder also can be specified as "+folder message" in case 
  MH format(default) in use. But, this is deprecated.

USAGE

    exit(1);
}

####################################################################
#  DESCRIPTION: Issue a message and exit (on fatal errors)
#        INPUT: Eror message
#       OUTPUT: None
# SIDE EFFECTS: None
####################################################################
sub GiveUp
{
my($msg) = @_;

    chomp($msg);
    print STDERR "$msg\n";
    print STDERR "STT aborts.\n";
    exit(1);
}

####################################################################
#  DESCRIPTION: Shows debug message
#        INPUT: Debug message, level of debugging
#       OUTPUT: None
# SIDE EFFECTS: None
####################################################################
sub Debug
{
my($msg, $lvl) = @_;

    chomp($msg);
    print STDERR "Line $.: " if($debug > 1);
    print STDERR "$msg\n" if($debug > 0);
}

####################################################################
#  DESCRIPTION: Handles various signals
#        INPUT: Signal number
#       OUTPUT: None
# SIDE EFFECTS: None
####################################################################
sub OnSignal
{
my($sig) = @_;

    print STDERR "\nSTT: Caught signal SIG$sig, terminating...\n";
    # Delete various temporary files
#    unlink("$TMPDIR/sttmsg.$$");
#    unlink("$TMPDIR/sttedit.$$");
#    unlink("$TMPDIR/sttedit.$$.bak");
    # stterror not cleaned, may be needed
    exit(1);
}


####################################################################
# Template, used to create new STTs
####################################################################

__DATA__

# %I% %D%

//VERSION 2.00

//TITLE	A simple example of STT template

//DESCR
Longer description of STT template
What it is doing and how
/*

# the template text itself

//TEMPLATE
From: RIPE NCC Staff <$logname@ripe.net>
To: $toname <$toaddr>
Cc: $cc
Fcc: cur
Subject: Re: $subject
Reply-To: $logname@ripe.net
X-Organization: RIPE Network Coordination Centre
X-Phone: +31 20 535 4444
X-Fax:   +31 20 535 4445


Dear $toname,

Blah-blah $moreblah

"$text"

$signame
RIPE NCC

---------------------

Original message was:

From: "$toname" <$toaddr>
Subject: $subject

$body

/*


# definition/declaration of all the variables
#
#     name	reply-deriv		default 

//VAR toname	"repl-name"		""
//VAR toaddr	"repl-addr"		""
//VAR cc	"cc"			""
//VAR subject	"subject"		"Your mail"

# Only first 10 lines of the body
//VAR body	"body/10L"		""
//VAR myname    ""                      "BUILTIN"
//VAR signame   ""                      "BUILTIN"
//VAR logname   ""                      "BUILTIN"
//VAR moreblah	""			"You"

//VARMULTI text "X-text"
    Just a silly text.
		    !!!!Very silly.!!!!
So silly, that I don't want to continue....
/*


# Prompt strings (descriptions) for the variables
#
#      name      "description"

//PRO toname	"name of recipient"
//PRO toaddr	"mail address of recipient"


# Variables to be taken from the command line (in this sequence)

//ARGS	toname	toaddr


# Variables to be prompted (in this sequence)

//ASK	toname	toaddr

# Code part - for experts only

# variables to be assigned if condition  is true

//OTEXTCOND	moreblah
my($var) = `pwd`;
if(!$?)
    {
    $moreblah .= "'s home directory is $var";
    }
else
    {
    $moreblah .= " are homeless!";
    }
/*

# derivations of variables

//DERIV
# add syntactic sugar for faxes automagically
$toaddr = "$toaddr.fax\@ripe.net" if $toaddr =~ /^[+]*[0-9]+$/;

# quote message body, like normal mailers do :)
$body =~ s/^(.*)/> $1/gm;

/*
