#! /usr/bin/perl -w

use strict ;
use Repocafe ;

my $TEMPL    = 'lib/setup.sql' ;
my @TYPES    = qw(DROP CREATE INSERT GRANT ALTER) ;
my $LANGUAGE = 'plpgsql' ;

my $prog = substr($0,rindex($0,'/')+1) ;
my $Usage = <<USAGE ;
Usage: $prog [-v] [-q] [-d] [-f] [-sql] [-c conf] [ table ]
option v   : be verbose
option q   : be quiet ; print only sql commands
option d   : show debug info
option f   : action ; otherwise dry-run
option sql : just show the sql to be executed
option c   : use config-file <conf>
argument table : only process <table> (unless -sql is specified)
----------------------------------------
- $prog - setup the repocafe database tables.
- Program setup-db creates missing tables, foreign key constraints etc.
- After doing a dry-run, create the database setup with option -f.
  If, during setup, you change your config, re-run setup-db.
- Use 'setup-db -f' with care, after setup is complete.
----------------------------------------
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') ;
our %opt = () ; Usage('') unless GetOptions
  ( \%opt, qw(v q d f sql c=s help) ) ;
if ( $opt{help} ) { print $Usage ; exit 0 ; }
Usage("Arg count\n") unless @ARGV <= 1 ;

$opt{v} ||= $opt{d} ;
$opt{q} ||= $opt{sql} ;

my $TAB = shift ;

my $Cafe = make_cafe ( %opt, d => 0, -conn => 0 ) ;
my $conf = $Cafe -> conf ;
$Cafe -> db_connect_as ( $conf -> db_owner, $conf -> db_opswd ) ;
my $dbh = $Cafe -> _dbh ;

printf "looking at database %s ...\n", $conf -> db_name unless $opt{q} ;

if ( $TAB )
  { my $name = $TAB ;
    my @names = sort map { $_ -> _name ; } @{ $Cafe -> _tabs } ;
    Error "unknow table $name ; available tables :\n  @names"
      unless $TAB = $Cafe -> _has_tab ( $TAB ) ;
  }

my $db_user = $conf -> db_user ;
my $db_rupd = $conf -> db_owner ;

sub trim
  { my $x = shift ;
    $x =~ s/[\s]+$// ;
    $x =~ s/^\s+// ;
    $x ;
  }

sub get_tups
  { my $sql = shift ;
    my $tab = shift ;
    my @res = () ;
    my $sth = $dbh -> prepare ( $sql ) ;
    $sth -> execute ( @$tab ) ;
    while ( my $rec = $sth -> fetchrow_hashref )
      { push @res, $rec ; }
    @res ;
  }

sub vrfy_languages
  { my $tab = 'pg_catalog.pg_language' ;
    my $sql = "SELECT * FROM $tab WHERE lanname = '$LANGUAGE'" ;
    scalar get_tups $sql, [] ;
  }

# select usesuper from pg_user where usename = 'ictb' ;

sub find_user
  { my $user = shift ;
    my $sql  = "SELECT * FROM pg_roles where rolname = ?" ;
    my @tups = get_tups $sql, [ $user ] ;
    @tups ? $tups [ 0 ] -> { rolname } : '' ;
  }

sub table_cnt
  { my $tab  = shift ;
    my $tabl = ( ( ref $tab ) ? $tab -> _tabl : $tab ) ;
    my $res  = undef ;
    my $sql  = "SELECT count(*) as count FROM $tabl" ;
    my @tups = get_tups $sql, [] ;
    if ( @tups )
      { $res = $tups [ 0 ] -> { count } ; }
    else
      { Error "can't ($sql)" ; }
    $res ;
  }

sub exec_sql
  { my $cmd = shift ;
    chop $cmd while $cmd =~ /[;\s]$/ ;
    if ( $opt{f} )
      { printf "executing ...\n$cmd\n" ;
        my $sth = $dbh -> prepare ( $cmd ) ; $sth -> execute () ;
      }
    else
      { printf "%s ;\n", $cmd ; }
  }

sub exec_sqls
  { my $cmds = shift ;
    for my $cmd ( @$cmds )
      { exec_sql $cmd ; }
  }

sub mk_raws
  { open TEMPL, $TEMPL ;
    my @text = grep { ! /(^#)|(^\s*)$/, } <TEMPL> ;
    close TEMPL ;

    my @raws = () ;
    my $raw  = '' ;

    for my $line ( @text )
      { if ( $line =~ /^\S/ )
          { if ( $raw )
              { push @raws, trim $raw ; $raw = '' ; }
          }
        $raw .= $line ;
      }

    if ( $raw =~ /^\S/ )
      { push @raws, trim $raw ; }
    else
      { Error "weird last command ($raw)" ; }

    printf "raws :\n[ %s\n]\n", join "\n, ", @raws if $opt{d} ;
    @raws ;
  }

sub mk_cmd
  { my $raw = shift ;
    my $typ = shift ;
    my $fkc = [] ;
    my $name ;
    if ( $raw =~ /^DROP TABLE IF EXISTS %(\w+)%/
      or $raw =~ /^CREATE TABLE %(\w+)%/
      or $raw =~ /^INSERT INTO %(\w+)%/
       )
      { $name = $1 ; }
    elsif ( $raw =~ /^GRANT [A-Z,\s]+ ON (SEQUENCE )?%(\w+)%/ )
      { $name = $2 ; }
    elsif ( $raw =~ /^ALTER SEQUENCE %(\w+)%/ )
      { $name = $1 ; }
    elsif ( $raw =~ /^CREATE OR REPLACE FUNCTION (\w+)/ )
      { $typ = 'FUNC' ; $name = $1 ; }
    elsif ( $raw =~ /^DROP TRIGGER IF EXISTS \w+ ON %(\w+)%/ )
      { $typ = 'TRIGd' ; $name = $1 ; }
    elsif ( $raw =~ /^CREATE TRIGGER.*AFTER INSERT ON %(\w+)%/s )
      { $typ = 'TRIGc' ; $name = $1 ; }
    elsif ( $raw =~ /^DROP INDEX IF EXISTS %(\w+)%/ )
      { $typ = 'INDEXd' ; $name = $1 ; }
    elsif ( $raw =~ /^CREATE INDEX %(\w+)%/s )
      { $typ = 'INDEXc' ; $name = $1 ; }

    Error "can't find name in raw ($raw)" unless defined $name ;
    Error "unknown tab ($name) in raw ($raw)"
      if $raw =~ /CREATE TABLE/ and not $Cafe -> _has_tab ( $name ) ;

    for my $line ( split /\n/, $raw )
      { if ( $line =~ /, (\w+).*REFERENCES %(\w+)% \( (\w+) \) ?(.*)/ )
          { my $pkey = $1 ;
            my $ftab = $2 ;
            my $fkey = $3 ;
            my $tail = $4 ;
            if ( $tail and $tail ne 'ON DELETE CASCADE' )
              { Error "weird tail ($tail)" ; }
            push @$fkc,
              [ "$name.$1" # ptab.pkey
              , "$2.$3"    # ftab.fkey
              , ( $tail || '' )
              ] ;
          }
        elsif ( $line =~ /REFERENCES/ )
          { Error "can't match REFERENCE line ($line)" ; }
      }

    my $cmd = $raw ;
    $cmd =~ s/%db_user%/$db_user/go ;
    $cmd =~ s/%db_rupd%/$db_rupd/go ;
    for my $tab ( $Cafe -> _tabs )
      { my $pat = sprintf '%%%s%%', $tab -> _name ;
        my $tabl = $tab -> _tabl ;
        $cmd =~ s/$pat/$tabl/g ;
      }
    printf "tab (%s) typ (%s) cmd(%s)\n", $name, $typ, $cmd if $opt{d} ;
    printf "%s\n", $cmd if $opt{sql} ;
    ( $typ, $name, $cmd, $fkc ) ;
  }

sub mk_cmds
  { my @raws = @_ ; 
    my @nams = map { $_ -> _name } $Cafe -> _tabs ;
    my $cmds = {} ;
    my $fkcs = {} ;
    for my $typ ( @TYPES )
      { $cmds -> { $typ } { $_ } = [] for @nams ;
        $fkcs -> { $_ } = [] for @nams ;
      }
    my $pat = sprintf '^(%s) ', join '|', @TYPES ;
    for my $raw ( @raws )
      { Error "unkown command type in ($raw)\n" unless $raw =~ /$pat/o ;
        my ( $typ, $name, $cmd, $fkc ) = mk_cmd $raw, $1 ;
        if ( ! defined $TAB or $name eq $TAB -> _name )
          { push @{ $cmds -> { $typ } { $name } }, $cmd ;
            push @{ $fkcs -> { $name } }, @$fkc ;
          }
        elsif ( $opt{d} )
          { printf "skip $name\n" ; }
      }
    ( $cmds, $fkcs ) ;
  }

# , rid integer NOT NULL REFERENCES %repos% ( id ) ON DELETE CASCADE

sub drp_fkc
  { my ( $tab, $name ) = @_ ;
    "ALTER TABLE $tab\n    DROP CONSTRAINT $name" ;
  }

# "beta_repo_rights_rid_fkey" FOREIGN KEY (rid) REFERENCES beta_repos(id)

sub add_fkc
  { my ( $ptab, $pkey, $ftab, $fkey ) = @_ ;
    my ( $ptabl, $ftabl ) = map { $Cafe -> $_ -> _tabl ; } $ptab, $ftab ;
    my $tail =
      ( ( $ptab eq 'rights' and $pkey eq 'mod' )
      ) ? '' : "ON DELETE CASCADE" ;
    my $name = sprintf "%s_%s_fkey", $ptabl, $pkey ;
    "ALTER TABLE $ptabl\n"
    . "    ADD CONSTRAINT $name\n"
    . "    FOREIGN KEY ($pkey) REFERENCES $ftabl ( $fkey ) $tail"
    ;
  }

sub make_tables
  { my $CMDS = shift ;
    my $cmds = [] ;
    my $msgs = [] ;
    
    for my $tab ( $TAB || $Cafe -> _tabs )
      { unless ( $tab -> _in_db )
          { my $name = $tab -> _name ;
            my $tabl = $tab -> _tabl ;
            push @$msgs, "$name : create table '$tabl'" ;
            push @$cmds, @{ $CMDS -> { CREATE } { $name } } ;
            push @$cmds, @{ $CMDS -> { GRANT  } { $name } } ;
          }
      }

    ( $cmds, $msgs ) ;
  }

sub sql_insert_paths
  { my $repos = $Cafe -> repos ;
    my $paths = $Cafe -> paths ;
    my $repos_tabl = $repos -> _tabl ;
    my $paths_tabl = $paths -> _tabl ;

    my $sql1 = <<SQL1 ;
INSERT into $paths_tabl ( id, rid, path, publ )
  SELECT id, id , '', publ FROM $repos_tabl
  WHERE id NOT IN ( SELECT id  FROM $paths_tabl )
    AND id NOT IN ( SELECT rid FROM $paths_tabl ) ;
SQL1
    my $sql2 = <<SQL2 ;
SELECT pg_catalog.setval
  ( '${paths_tabl}_id_seq'
  , ( SELECT last_value from ${repos_tabl}_id_seq )
  , true
  ) ;
SQL2
    $sql1, $sql2 ;
  }

sub make_inserts
  { my $CMDS = shift ;
    my $cmds = [] ;
    my $msgs = [] ;

    my $mods = $Cafe -> mods ;
    unless ( $mods -> _in_db and 3 == table_cnt $mods )
      { push @$msgs, "mods  : insert static values" ;
        $cmds = $CMDS -> { INSERT } { mods } ;
      }

    my $repos = $Cafe -> repos ;
    my $paths = $Cafe -> paths ;
    my ( $sql1, $sql2 ) = sql_insert_paths ;

    if ( $repos -> _in_db and $paths -> _in_db )
      { if ( table_cnt ( $paths ) < table_cnt ( $repos ) )
          { push @$msgs, "paths : insert values" ;
            push @$cmds, $sql1, $sql2 ;
          }
      }
    else
      { push @$msgs, "paths : can't insert values yet" ;
#       push @$msgs, $sql1, $sql2 ;
      }

    ( $cmds, $msgs ) ;
  }

sub check_fkcs
  { my $FKCS = shift ;
    my $rep  = shift ;

    my $cmds = [] ;
    my $msgs = [] ;
    my %done = () ;

    for my $mis ( @{ $rep -> { miss } } )
      { my ( $p, $f ) = @$mis ;
        my $fki = $rep -> { $p } { $f } ;
        push @$cmds, add_fkc split /\./, "$p.$f" ;
        push @$msgs, "* missing $p -> $f" ;
        $done { "$p.$f" } ++ ;
      }
    
    for my $bad ( @{ $rep -> { bads } } )
      { my ( $p, $f, $h ) = @$bad ;
        my $fki  = $rep -> { fkis } { $p } { $h } ;
        my $tabl = $fki -> { _ptab } ;
        my $name = $fki -> { name } ;
        push @$cmds, drp_fkc $tabl, $name ;
        push @$cmds, add_fkc split /\./, "$p.$f" ;
        push @$msgs, "* drop $p -> $h ; add $p -> $f" ;
        $done { "$p.$f" } ++ ;
      }

    my $fkcs = [ map { @$_ ; } values %$FKCS ] ;
    for my $fkc ( @$fkcs )
      { my ( $p, $f, $tail ) = @$fkc ;
        next if $done { "$p.$f" } ;
        my $fki = $rep -> { fkis } { $p } { $f } ;
        if ( $opt{d} and $fki )
          { Blib::_pr_hash ( "$p -> $f", $fki ) ;
            printf "rule (%s) tail (%s)\n", $fki -> {rule}, $tail ;
          }
        if ( $fki
         and ( $fki -> { rule } eq '0'
           xor $tail eq 'ON DELETE CASCADE'
             )
           )
          { push @$cmds, drp_fkc $fki -> { _ptab }, $fki -> { name } ;
            push @$cmds, add_fkc split /\./, "$p.$f" ;
            push @$msgs, "* drop $p -> $f ; set/drop CASCADE" ;
          }
        elsif ( ! $fki )
          { printf "no fki for ($p) -> ($f), '$tail'\n" if $opt{v} ; }
      }
    
    ( $cmds, $msgs ) ;
  }

#   $dbh -> prepare ( $sql1 ) -> execute ;
#   my $count = ( get_tups ( $sql2 ) ) [ 0 ] -> { last_value } ;
#   my $sql3 = "SELECT setval('beta_repo_paths_id_seq', $sql2, true)" ;
#   printf "%s\n%s\n", $sql1, $sql2 ;
#   $dbh -> prepare ( $sql3 ) -> execute ;

Error "db_user ($db_user) not found" unless find_user $db_user ;

unless ( $conf -> db_owner and $conf -> db_opswd )
  { $db_rupd = $db_user ;
    printf
      "db_owner/opswd empty ; db user '%s' can change repo_roots\n"
        , $db_user unless $opt{sql} ;
  }

if ( $opt{sql} )
  { print "CREATE LANGUAGE $LANGUAGE ;\n" ; }
elsif ( ! vrfy_languages )
  { printf "checking languages ...\n" unless $opt{q} ;
    exec_sql "CREATE LANGUAGE $LANGUAGE" ;
  }

my @raws = mk_raws ;
my ( $CMDS, $FKCS ) = mk_cmds @raws ;

if ( $opt{sql} ) { print sql_insert_paths ; exit ; }

my $cmds ;
my $msgs ;

( $cmds, $msgs ) = make_tables $CMDS ;
if ( @$msgs )
  { unless ( $opt{q} )
      { printf "create tables ...\n" ;
        printf "  %s\n", join "\n  ", @$msgs ;
      }
    exec_sqls $cmds ;
  }

( $cmds, $msgs ) = make_inserts $CMDS ;
if ( @$msgs )
  { unless ( $opt{q} )
      { printf "insert into tables ...\n" ;
        printf "  %s\n", join "\n  ", @$msgs ;
      }
    exec_sqls $cmds ;
  }

( $cmds, $msgs ) = check_fkcs $FKCS, $Cafe -> check_tabs ;
if ( @$msgs )
  { printf "fix contraints ...\n" unless $opt{q} ;
    exec_sqls $cmds ;
  }

$cmds = [ map { @$_ } values %{ $CMDS -> { GRANT } } ] ;
if ( @$cmds )
  { printf "set grants ; just to make sure ...\n" unless $opt{q} ;
    exec_sqls $cmds ;
  }

$cmds = [ map { @$_ } values %{ $CMDS -> { ALTER } } ] ;
if ( @$cmds )
  { printf "set sequence owners ; just to make sure ...\n" unless $opt{q} ;
    exec_sqls $cmds ;
  }

$cmds = [ map { @$_ } values %{ $CMDS -> { FUNC } } ] ;
if ( @$cmds )
  { printf "define functions ...\n" unless $opt{q} ;
    exec_sqls $cmds ;
  }

$cmds =
  [ map { @$_ } values %{ $CMDS -> { TRIGd } }
  , values %{ $CMDS -> { TRIGc } }
  ] ;
if ( @$cmds )
  { printf "define triggers ...\n" unless $opt{q} ;
    exec_sqls $cmds ;
  }

$cmds =
  [ map { @$_ } values %{ $CMDS -> { INDEXd } }
  , values %{ $CMDS -> { INDEXc } }
  ] ;
if ( @$cmds )
  { printf "define index-es ...\n" unless $opt{q} ;
    exec_sqls $cmds ;
  }

printf "\n$prog : THIS IS A DRY-RUN on database %s\n", $conf -> db_name
  unless $opt{f} ;