#!/usr/bin/perl -w
use strict;
use Text::CSV_XS;

# Configuration {{{
my %output = (
  sql => {
    add => sub {" + $_[0]"},
    "elseif" => sub {"WHEN $_[0] = $_[1] THEN 0 \n"},
    "if" => sub {"+ CASE WHEN $_[0] = $_[1] THEN 0 \n"},
    endif => sub {"END"},
    func_spec => sub{""},
    func => sub{"0 $_[2]"}
  },
  vba => {
    add => sub {"res = res + $_[0]"},
    "elseif" => sub {"elseif $_[0] = $_[1] then\n"},
    "if" => sub {"if $_[0] = $_[1] then\n"},
    endif => sub {"end if"},
    func_spec => sub {join(", ", @_)},
    func => sub{"function $_[0] ($_[1]) as double\ndim res as double\nres = 0\n\n$_[2]\n$_[0] = res\nend function\n"}
  }
);
# }}}

my $CSV = Text::CSV_XS->new();
my $int =0; my $elem = {}; 
my %catf = (); my %contf =();
my $filename = shift;
my $output_name = shift;
my $output_hash = $output{$output_name}
  || die "Failed to find output type '$output_name'";

open (FILE, "$filename.csv") || die "Failed to open $filename.csv";

while (<FILE>) {
	local $/ ="\r\n" if /\r/;
	chomp;
	s/\s//g;
	die "Failed to parse $_" unless $CSV->parse($_);
	my ($expr, $val) = $CSV->fields();
  $val ||= 0;
	next unless $val!=0;

  # Get all components in this interaction
  my @comp = split(/:/, $expr);
  # Pull out the categorical ones...
	my @cat = grep {/\[/} @comp;
  @cat = ('base[T.1]') unless @cat; # Create dummy category is reqd
  # ...and the continuous ones
  my @cont = grep {$_ !~  /\[/} @comp;
  @cont = grep {$_ ne '(Intercept)'} @cont;

  my @catnames = map { /(.*)\[/; $1 } @cat;
  @catf{@catnames} = (1) x scalar @catnames;
  @contf{@cont} = (1) x scalar @cont;
  # Add this variable into the $elem hash
  create_node($elem, [@cont], [@cat], $val);
}
close(FILE);

# Convert the $elem hash into the output function
my $str = create_func(0, '', $elem, $output_hash);
delete $catf{'base'};
my $param = $output_hash->{func_spec}->(sort keys %catf, sort keys %contf);
$str = $output_hash->{func}->("calc_$filename", $param, $str);
print $str . "\n";

sub create_node {
  my ($hash, $cont, $cat, $val) = @_;
  my $num = $#$cat;
  my $rhash = $hash;
  foreach my $i (0..$num) {
    $_ = $cat->[$i];
    my ($lu, $code) = (/(.*)\[T\.(.*)\]/);
    $code || die "Failed to find Treatment contrast in $_";
    $rhash->{$lu} ||= {};

    $rhash->{$lu}->{$code} ||= {};
    if ($i == $num) {
      $rhash->{$lu}->{$code}->{data} ||= [];
      push @{$rhash->{$lu}->{$code}->{data}}, join(' * ', (@$cont, $val));
    } else {
      $rhash = $rhash->{$lu}->{$code};
    }
  }

  return $hash;
}

sub create_func {
  my ($lvl, $str, $node, $funcs) = @_;
  if (ref($node) eq 'HASH') {
    foreach (keys %$node) {
      my $elem = $node->{$_};

      if ($_ eq 'data') {
        foreach my $item (@{$elem}) {
          $str .= "\t" x ($lvl);
          $str .= $funcs->{add}->($item) . "\n";
        }
        next;
      }

      my $firstdef = 1;

      foreach my $key (keys %$elem) {
        next unless defined $elem->{$key};
        my $chk = $elem->{$key};
        $str .= "\t" x $lvl;

        if ($key !~ /^[\d\.]*$/) {
          $key = "\"$key\"";
        }

        if ($firstdef) {
          $firstdef = 0;
          $str .= $funcs->{'if'}->($_, $key) unless $_ eq 'base';
        } else {
          $str .= $funcs->{'elseif'}->($_, $key);
        }

        if (ref($chk)) {
          $str = create_func($lvl+1, $str, $chk, $funcs);
        }

      }
      if ($_ ne 'base') {
        $str .= "\t" x ($lvl);
        $str .= $funcs->{'endif'}->(). "\n";
      }
    }
  }

  return $str;
}
