#!/usr/bin/perl -w
##########################################################################
#    This is the perl-script mktc     				         #
#       >>>>  a "compiler" for tcharge charge-files <<<<       	         #
#    Author: Volker B"orchers <boercher@physik.uni-bremen.de>	         #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#
# This file is a part of tcharge, version 1.3, 11MAY98			 #
# Copyright (C) 1997,98 Volker B"orchers (boercher@physik.uni-bremen.de) #
# See file `tcharge.c' for legal affairs.				 #
##########################################################################

die "Missing argument: need charge-file-name!\n" if($#ARGV != 0);
$infile = $ARGV[0];
$head = "$infile.h";

##
## function `bool' expects two arguments ($var, $val). $val
## can optionally start with "d=". `bool' returns
##  1 if (the rest of) $val is "true"
##  0 if (the rest of) $val is "false"
##
sub bool {
    my($var,$val) = @_;
    $val =~ s/^d=//;
    if($val eq "true") {
	return 1;
    }
    elsif($val eq "false") {
	return 0;
    }
    else {
	die "$0: \`$var\' has wrong type\n",
	"\t(\`true\' or \`false\', not \`$val\')\n";
    }
}
##
## function `get_number' expects two arguments ($var, $val). $val
## can optionally start with "d=". `get_number' returns
## the numeric value of $val if $val is a valid number.
##
sub get_number {
    my($var,$val) = @_;
    $val =~ s/^d=//;
    $val =~ /^[-+\d.eE]+$/
	|| die "$0: \`$var\' has wrong type: \`$val\' should be numeric!\n";
    return $val;
}
##
## function `get_string' expects two arguments ($var, $val). $val
## can optionally start with "d=". `get_string' returns the string
## if it is a valid double-quoted string.
##
sub get_string {
    my($var,$val) = @_;
    $val =~ s/^d=//;
    $val =~ /^\"[^\"]*\"$/
	|| die "$0: \`$var\' (defined?) must be a \"double-quoted\" string\n";
    return $val;
}
##
## function `get_seconds' expects a hh:mm time argument and returns the
## day seconds.
##
sub get_seconds {
    my($s) = @_;
    ($h,$m) = ($s =~ /(\d+):(\d+)/);
    return $h*3600 + $m*60;
}

##
## Global variables:
##
$num_zones = 0;
$time_zones = 0; # a maximum
$days_a_week = 0;
%vars = (); # global variable
sub get_vars {
    my(@in) = @_;
    %vars = (
	     'billing_per_unit'		=> "d=",	# either...
	     'unit_price'		=> "d=",	# ...and...
	     'billing_per_second'	=> "d=",	# ...or!
	     'charge_date'		=> "d=",	# required
	     'currency_name'		=> "d=",	# required
	     'currency_after_charge'	=> "d=false",	# optional
	     'zone_help_string'		=> "d=\"\"",	# optional
	     'holidays'			=> "d=",	# optional
	     'decimals'			=> "d=2",	# optional
	     'nominal_charge'		=> "d=0.",	# optional
	     'minimal_charge'		=> "d=0.",	# optional
	     'reduction_second'		=> "d=-1.",	# optional, x...
	     'reduction_unit'		=> "d=-1",	# optional, ...or!
	     'reduction_ratio'		=> "d=0.",	# optional
	     );
    ## variables (only numeric!) that _may_ differ from zone to zone:
    @local_keys = ('nominal_charge', 'minimal_charge',
		   'reduction_second', 'reduction_unit', 'reduction_ratio');
    $num_vars = keys(%vars);
    foreach $line (@in) {
	($var,$value) = ($line =~ /\s*(\w+)\s*=\s*(.*)/);
	$var =~ tr/A-Z/a-z/;
	$vars{$var} = $value;
	die "$0: unknown variable name \`$var\'\n"
	    if(keys(%vars) > $num_vars);
    }
}

##
## install signal handler for cleanup
##
sub handler {       # 1st argument is signal name
    system "rm -f zone* tmp";
}
$SIG{'HUP'} = 'handler';
$SIG{'INT'} = 'handler';
$SIG{'TERM'} = 'handler';
$SIG{__DIE__} = sub { handler(); };

##
## First: read the file and preformat the information:
## put global inforamtion into the array `@global'
## and the charge-information into the files `zone0'...
##
open(INFILE, "$infile")
    || die "$0: Cannot open $infile\n";
$line = 0;
$global_stuff = 1;
READ:
while(<INFILE>) {
    $line++;
    chomp();
    s/#.*//;
    s/\s+$//;
    next READ if($_ eq "");

    if(/^begin/i) {
	$zonefile = "zone$num_zones";
	open(ZONEFILE, ">$zonefile")
	    || die "$0: Cannot open temporary file \`$zonefile\' for writing\n";
	$global_stuff = 0;
	$num_zones++;
	$days_a_week_tmp = 0;
	$time_zones_tmp = 0;
	next READ;
    }
    elsif(/^end/i) {
	close ZONEFILE;
	if($days_a_week && $days_a_week != $days_a_week_tmp) {
	    die "$0 - Error: Every \`zone\' must provide the same number",
		 "\n\tof sections (-> days_a_week)\n";
	}
	$days_a_week = $days_a_week_tmp;
	$time_zones = $time_zones_tmp
	    if($time_zones < $time_zones_tmp);
	next READ;
    }
    elsif(!/.*\w+\s*=.*/) { # Syntax-check: no variable!
	die "Unexpected token in line $line ("
	    if($global_stuff && !/^\s*\d/);
    }

    if($global_stuff) {
	push @global, $_ ;
    } else {
	s/^\s*//;
	if(/^00:00/) {
	    $days_a_week_tmp++;
	    $time_zones = $time_zones_tmp
		if($time_zones < $time_zones_tmp);
	    $time_zones_tmp = 0;
	}
	$time_zones_tmp++ if(/^\d/);
	print ZONEFILE $_, "\n";
    }
}

##
## print a header for the C-header-file:
##
open(HEAD, ">$head")
	    || die "$0: Cannot open $head for writing\n";
print HEAD <<EOF;
/*
 * Automatically generated from file \`National/$infile\' - don\'t edit!
 * -----------------------------------------------------------------------
 * This is the charge header for $infile
 * This file is a part of tcharge, version \1.3 \11MAY98
 * Copyright (C) 1997,98 Volker B\"orchers (boercher\@physik.uni-bremen.de)
 * See file \`tcharge.c\' for legal affairs.
 */

#define COUNTRY \"$infile\"
#define NUM_ZONES $num_zones   /* Number of regional zones */
#define TIME_ZONES $time_zones  /* max. Number of time bands */
#define DAYS_A_WEEK $days_a_week
EOF

##
## Evaluate the variables in the global section
##
get_vars(@global);
## Billing_per_?????, UNIT_PRICE:
if(! bool("billing_per_unit", $vars{billing_per_unit}) ) {
    if(! bool("billing_per_second", $vars{billing_per_second}) ) {
    	die "$0: Either \`billing_per_unit\' or \`billing_per_second\' ",
	"must be specified!\n";
    }
} else { ## BILLING_PER_UNIT:
    print HEAD "#define BILLING_PER_UNIT\n";
    die "$0: When \`billing_per_unit\' we need the \`unit_price\'!\n"
	if($vars{unit_price} =~ /^d=/);
    $tmp = get_number("unit_price", $vars{unit_price});
    print HEAD "#define UNIT_PRICE $tmp\n";
}
## Required variables (strings):
foreach $key ('charge_date', 'currency_name') {
    $vars{$key} = get_string($key,$vars{$key});
    die "$0: Variable \`$key\' is required!\n"
	if(! $vars{$key});
    print HEAD "#define \U$key\E $vars{$key}\n";
}
## CURRENCY_AFTER_CHARGE:
$key = 'currency_after_charge';
print HEAD "#define \U$key\E\n"
    if(bool("$key", $vars{$key}) );
## ZONE_HELP_STRING:
$key = 'zone_help_string';
$vars{$key} = get_string($key,$vars{$key});
print HEAD "#define \U$key\E $vars{$key}\n"
    if($vars{$key} && $vars{$key} ne '""');
## HOLIDAYS:
$key = 'holidays';
if($vars{$key} =~ s/^d=//) { # no holidays defined
    print HEAD "int holidays[] = {0};   ", 
    "/* first entry = number of specified holidays */\n";
} else {
    $rem = $vars{$key}; $rem =~ tr/,0-9//d;
    die "$0: \`$key\' contains illegal characters: \`$rem\'\n"
	if($rem ne "");
    @tmp = (split /,/, $vars{$key});
    $num_holidays = @tmp;
    print HEAD "int holidays[] = {$num_holidays,$vars{$key}};\n";
}
## All other numeric variables:
foreach $key ('decimals', @local_keys) {
    $val = get_number("$key", $vars{$key});
    if(int($val) != $val || $val =~ /\./) { ## a little bit simple...
	print HEAD "float \U$key\E = $val;\n";
    } else {
	print HEAD "int \U$key\E = $val;\n";
    }
    if($key eq "reduction_ratio" && $val+0 && $val+0 < .5) {
	warn "*\n* Warning: \`$key\' value (=$val) lower than 50%, ",
	"hope that\'s OK.\n*\n";
    }
}

##
## Now the sections for different regional zones
##
print HEAD <<EOF;

/* Shortcut \`VFUNC\' for a void function pointer: */
typedef void(*VFUNC)();
EOF

open(TMP, ">tmp")
    || die "$0: Cannot open file \`tmp\' for writing\n";
print TMP <<EOF;

/*
 * Container for the charge information of one zone,
 *  "It" := {	"duration of a unit" (for billing_per_unit)
 *		"price of a minute"  (for billing_per_second)   }
 */
struct days{
  int n;	/* How often "It" changes */
  int start[TIME_ZONES]; /* time of day "It" changes [s] */
  float length[TIME_ZONES]; /* according "It" */
};

struct days zones[NUM_ZONES][DAYS_A_WEEK] = {
EOF

## makes the ZONES loop a little bit shorter (uses global variables):
sub print_one_day {
    my $tz = keys(%times);
    if($tz > 0) { ## (not at the first time)
	@t = ();
	@m = ();
	foreach $key (sort {$a <=> $b} keys(%times)) {
	    push @t, $key;
	    push @m, $times{$key};
	}
	print TMP "    {$tz,{";
	for(; $tz<$time_zones; $tz++) {
	    push @t, 0;
	    push @m, 0;
	}
	$,=","; print TMP @t;
	$,=""; print TMP "},{";
	$,=","; print TMP @m;
	$,=""; print TMP "}},\n";
    }
}

ZONES:
for($i=0; $i<$num_zones; $i++) {
    $zonefile = "zone$i";
    open(ZONEFILE, "$zonefile")
	|| die "$0: Cannot open $zonefile for reading\n";
    chomp(@zone = <ZONEFILE>);
    ## generate functions for initialisation for each zone:
    ## Now the `struct days' stuff:
    if($i > 0) {
	print TMP ",{\n";
    } else {
	print TMP "  {\n";
    }
    ## 1. Variable definition lines...
    print HEAD "void zone$i()\n{\n";
    @vars = grep(/.*\w+\s*=.*/, @zone);
    if(@vars) {
	if(@vars > @local_keys) { # Catches not all faults of this kind
	    $,="\n\t"; 
	    print STDERR "$0: Only the following variables may be set ",
	    "for each section:\n";
	    $,="";
	}
	get_vars(@vars);
	foreach $key (@local_keys) {
	    ## Accept no default values:
	    if($vars{$key} !~ /^d=/) {
		$val = get_number("$key", $vars{$key});
		print HEAD "  \U$key\E = $val;\n";
		if($key eq "reduction_ratio" && $val+0 && $val+0 < .5) {
		    warn "*\n* Warning: \`$key\' value (=$val) lower than 50%, ",
		    "hope that\'s OK.\n*\n";
		}
	    }
	}
    }
    print HEAD "}\n";
    ## 2. Lines concerning charges
    @days = grep(!/.*\w+\s*=.*/, @zone);
    foreach $line (@days) {
	($time,$money) = ($line =~ /([\d:]+)\s+([\d.]+)/);
	$time = get_seconds($time);
	if($time == 0) {
	    print_one_day();
	    %times = ();
	}
	$times{$time} = $money;
    }
    print_one_day();
    %times = ();
    
    print TMP "  }";
    close ZONEFILE;
}
# an array of zone-functions:
print HEAD "VFUNC init_zone[] = { /* array of init-functions */\n  ";
for($i=0; $i<$num_zones-1; $i++) { print HEAD "zone$i, "; }
print HEAD "zone$i\n};\n";

print TMP "\n};\n";
close TMP;
## append TMP to HEAD
open(TMP, "tmp")
    || die "$0: Cannot open file \`tmp\' for reading\n";
print HEAD <TMP>;

print <<EOF;

Everything seems to be OK.
Output in $head!

To get it into work:
--------------------
1. edit 'Makefile':
  - Add a comment for '$infile' (which telephone company)
  - Add a make-direction for 'make $infile'
  - Add an entry in the 'default:' section
  - Choose the debug CFLAGS (with '-g' and '-DDEBUG') 
2. make tcharge following the advices in file `INSTALL' (starting at
   item 2).
3. test tcharge (also see `INSTALL': "Testing tcharge") and check if
   your charge file does his work. If not ... see you again!
EOF

handler();
