#! /usr/bin/perl -w

use strict ;
use Repocafe ;

my $SCHEME_DEF = 'lib/scheme.dat' ;
my $SCHEME_TST = 'lib/scheme.new' ;
my $OUT_DEF = 'lib/Tabs.pm' ;
my $OUT_TST = 'zzz' ;
my %TABLE_NAMES = TABLE_NAMES () ;

my $prog = substr($0,rindex($0,'/')+1) ;
my $Usage = <<USAGE ;
Usage: $prog [-v] [-q] [-d] [-t]
option v : be verbose
option q : be quiet
option d : show debug info
option t : use     < $SCHEME_TST > $OUT_TST ;
           default < $SCHEME_DEF > $OUT_DEF ;
USAGE
sub Usage { die "$_[0]$Usage" ; }
sub Error { die "$prog: $_[0]\n" ; }
sub Warn  { warn "$prog: $_[0]\n" ; }

# usage: &GetOptions(ARG,ARG,..) defines $opt_ID as 1 or user spec'ed value
# usage: &GetOptions(\%opt,ARG,ARG,..) defines $opt{ID} as 1 or user value
# ARG = 'ID' | 'ID=SPC' | 'ID:SPC' for no-arg, required-arg or optional-arg
# ID  = perl identifier
# SPC = i|f|s for integer, fixedpoint real or string argument

use Getopt::Long ;
Getopt::Long::config('no_ignore_case') ;
my %opt = () ; Usage('') unless GetOptions
  ( \%opt, qw(v q d t) ) ;
Usage("Arg count\n") unless @ARGV == 0 ;

my $SCHEME = $SCHEME_DEF ;
my $OUT    = $OUT_DEF ;

if ( $opt{t} )
  { $SCHEME = $SCHEME_TST ;
    $OUT    = $OUT_TST ;
  }

@ARGV = ( $SCHEME ) ;

printf "IN  $SCHEME\n" ;
printf "OUT $OUT\n" ;

my %tabs = () ;
my @tabs = () ;
my $tab = '' ;
my $fld = {} ;

while ( <> )
  { chop ;
    next if /^\s*$/ ;
    next if /^#$/ ;
    my ( $key, $val ) = split ' ', $_, 2 ;
    $val = '' unless defined $val ;
    if ( $key eq 'T' )
      { $tab = $val ;
        $tabs { $tab } { cols } = [] ;
        push @tabs, $tab ;
      }
    elsif ( $key eq 'F' )
      { my ( $name, $type, $rw ) = split ' ', $val, 3 ;
        Error "bad F ($val)" unless $rw =~ /^(system|read|write)$/ ;
        $fld = 
          { name => $name
          , type => $type
          , rorw => $rw
          , uniq => 0
          , null => 1
          , def  => undef
          , fkey => undef
          } ;
        push @{ $tabs { $tab } { cols } }, $fld ;
      }
    elsif ( $key eq 'A' )
      { if ( $val eq 'pkey' )
          { $tabs { $tab } { pkey } = $fld -> { name } ;
            $fld -> { uniq } = 1 ;
            $fld -> { null } = 0 ;
          }
        elsif ( $val eq 'notnull' )
          { $fld -> { null } = 0 ; }
        elsif ( $val eq 'unique' )
          { $fld -> { uniq } = 1 ; }
        elsif ( $val =~ /^fkey\s+(\w+)\s+(\w+)$/ )
          { my $rtab = $1 ;
            my $rcol = $2 ;
            Error "remote tab not found $rtab" unless exists $tabs { $rtab } ;
            $fld -> { fkey } { $rtab } = $rcol ;
          }
        else
          { Error "bad A ($val)" ;
          }
      }
    elsif ( $key eq 'D' )
      { $fld -> { def } = $val ; }
    else
      { Error "unknown key ($key)" ; }
  }

sub par { "-$_[0] => $_[1]" ; }
sub quo { "'$_[0]'" ; }
sub brc { "{$_[0]}" ; }

my @defs = qw(name type rorw uniq null def fkey) ;
my %defs = 
  ( name => ''
  , type => ''
  , rorw => ''
  , uniq => '0'
  , null => '1'
  , def  => 'undef'
  , fkey => 'undef'
  ) ;

sub gen_col
  { my $col = shift ;
    my $type = $col -> { type } ;
    my $_def = $col -> { def } ;
    my %res  = () ;
    $res { name } = quo $col -> { name } ;
    $res { type } = quo $col -> { type } ;
    $res { uniq } = $col -> { uniq } ;
    $res { null } = $col -> { null } ;
    $res { def  } = 
      ( defined $_def ? ( $type eq 'text' ? quo $_def : $_def ) : 'undef' ) ;
    $res { fkey } = join
      ( ','
      , map
          { sprintf "\$self -> %s -> %s" , $_ , $col -> { fkey } { $_ } ;
          } keys %{ $col -> { fkey } }
      ) || 'undef' ;
    my $res = join "\n      , ",
      map { par $_, $res { $_ } }
#     map { printf "$_ res(%s) def(%s)\n", $res { $_ }, $defs { $_ } ; $_ ; }
      grep { exists $res { $_ } and $res { $_ } ne $defs { $_ } ; 
           } @defs ;
    <<COL ;
\$res -> add_col
      ( $res
      ) ;
COL
  }

sub gen_cols
  { my @cols = @_ ; join "    ", map { gen_col $_ ; } @cols ; }

sub gen_tab
  { my $tab  = shift ; 
    my $pkey = $tabs { $tab } { pkey } ;
    my $tabl = $TABLE_NAMES { $tab } ;
    Error "no table ($tab)" unless defined $tabl ;
    my $cols = gen_cols @{ $tabs { $tab } { cols } } ;
    Error "no pkey for table ($tab)" unless defined $pkey ;
    <<FMT ;
sub init_$tab
  { my \$self = shift ;
    my \$pref = shift ;
    my \$res  = \$self -> add_tab
      ( -name => '$tab'
      , -tabl => \$pref . '$tabl'
      , -pkey => '$pkey' 
      , -cafe => \$self
      ) ;
    $cols
    \$res ; 
  }

FMT
  }

sub gen_tabs
  { my $res = "package Blib::Dbs::Repocafe ;\n\n"
      . "use strict ;\n\n" ;
    my $fmt = <<'FMT' ;
sub define_tables
  { my $self = shift ;
    my $pref = $self -> conf -> db_pref ;
%s
    $self ;
  }

1 ;

FMT

    for my $tab ( @tabs )
      { $res .= gen_tab $tab ; }
    $res .= sprintf $fmt
      , join "\n"
      , map { sprintf "    \$self -> init_%s ( \$pref ) ;" , $_ ; } @tabs ;
    $res ;
  }
  
open OUT, ">$OUT" or Error "can't write $OUT ($!)" ;
print OUT gen_tabs ;
close OUT ;