#!/usr/bin/perl
#
# $Rev:: 46     $:
# $Date:: 2008-11-30 19:39:20 #$:

use strict;
use AppConfig  qw(:expand :argcount);
use Tie::File;

eval { require Convert::Cyrillic; };
my $can_translit = 1 unless ($@);

eval { require Template; };
my $can_template = 1 unless ($@);

eval { require Text::CSV_XS; };
my $can_csv = 1 unless ($@);

# TODO буфферизовать данные при генерации sql по шаблону
# TODO сделать возможной работу ключей --rename и --skip с кириллическими именами полей?
# TODO сделать расстановку commit через определенные промежутки, например --commit 1000 -- через каждые 1000 сгенерированных строк
# TODO игнорировать отсутствующие данные из mid?
# TODO проверка корректности указанных параметров (формат, значение)
# TODO проверка корректности поступающих из .mif данных
# TODO реализовать конвертацию данных типа Text опционально в полигоны или в линии
# TODO реализовать функцию удаления дубликатов объектов

my $conf = AppConfig->new(

    "help"           => { DEFAULT  => undef,  ARGCOUNT => ARGCOUNT_NONE, ALIAS => 'h' }, 

    "nopoly"         => { DEFAULT  => undef,  ARGCOUNT => ARGCOUNT_NONE }, 

    "table"          => { DEFAULT  => undef , ARGCOUNT => ARGCOUNT_ONE,  ALIAS => 't' }, 
    "column"         => { DEFAULT  => 'geom', ARGCOUNT => ARGCOUNT_ONE,  ALIAS => 'c' }, 
    "noddl"          => { DEFAULT  => undef,  ARGCOUNT => ARGCOUNT_NONE }, 
    "nodrop"         => { DEFAULT  => undef,  ARGCOUNT => ARGCOUNT_NONE }, 
    "dropempty"      => { DEFAULT  => undef,  ARGCOUNT => ARGCOUNT_NONE }, 
    "noindex"        => { DEFAULT  => undef,  ARGCOUNT => ARGCOUNT_NONE },
    "nodata"         => { DEFAULT  => undef,  ARGCOUNT => ARGCOUNT_NONE }, 
    "noinvalid"      => { DEFAULT  => undef,  ARGCOUNT => ARGCOUNT_NONE }, 

    "update"         => { DEFAULT  => undef,  ARGCOUNT => ARGCOUNT_NONE }, # TODO генерировать update вместо insert
    "id"             => { DEFAULT  => undef,  ARGCOUNT => ARGCOUNT_ONE  }, # TODO имя столбца-идентификатора для update

    "skip"           => { DEFAULT  => undef,  ARGCOUNT => ARGCOUNT_LIST },
    "skipnum"        => { DEFAULT  => undef,  ARGCOUNT => ARGCOUNT_LIST },
    "rename"         => { DEFAULT  => undef,  ARGCOUNT => ARGCOUNT_HASH },
    "ignore"         => { DEFAULT  => undef,  ARGCOUNT => ARGCOUNT_LIST },

    "before"         => { DEFAULT  => undef,  ARGCOUNT => ARGCOUNT_LIST },
    "after"          => { DEFAULT  => undef,  ARGCOUNT => ARGCOUNT_LIST },
    "afterddl"       => { DEFAULT  => undef,  ARGCOUNT => ARGCOUNT_LIST }, 
    "extra"          => { DEFAULT  => undef,  ARGCOUNT => ARGCOUNT_LIST }, 

    "mul"            => { DEFAULT  => undef,  ARGCOUNT => ARGCOUNT_ONE  }, 
    "div"            => { DEFAULT  => undef,  ARGCOUNT => ARGCOUNT_ONE  }, 
    "mirrorx"        => { DEFAULT  => undef,  ARGCOUNT => ARGCOUNT_NONE, ALIAS => 'mx' },
    "mirrory"        => { DEFAULT  => undef,  ARGCOUNT => ARGCOUNT_NONE, ALIAS => 'my' },
    "rotate"         => { DEFAULT  => undef,  ARGCOUNT => ARGCOUNT_ONE  },

    "mif"            => { DEFAULT  => "-",    ARGCOUNT => ARGCOUNT_ONE  }, 
    "mid"            => { DEFAULT  => undef,  ARGCOUNT => ARGCOUNT_ONE  }, 
    "srid"           => { DEFAULT  => '-1',   ARGCOUNT => ARGCOUNT_ONE  }, 
    "debug"          => { DEFAULT  => undef,  ARGCOUNT => ARGCOUNT_NONE, ALIAS => 'd'  },
    "translit"       => { DEFAULT  => undef,  ARGCOUNT => ARGCOUNT_ONE,  ALIAS => 'tr' },
    "sqltpl"         => { DEFAULT  => undef,  ARGCOUNT => ARGCOUNT_ONE,  ALIAS => 'st' }, 
    "ddltpl"         => { DEFAULT  => undef,  ARGCOUNT => ARGCOUNT_ONE,  ALIAS => 'dt' },
    "out"            => { DEFAULT  => undef,  ARGCOUNT => ARGCOUNT_ONE,  ALIAS => 'o'  },
    "vacuum"         => { DEFAULT  => undef,  ARGCOUNT => ARGCOUNT_NONE },
);


$conf->args();

if ($conf->help)
{
    print qq{

    $0 [ options ] --table name [ --mif file.mif ] [ --mid file.mid ] [ -o file.sql ]

    --table name    имя таблицы. фактически будет только частью имени:
        -tn name    после имени `name` будет добавлен суффикс из типа данных: poly, line или point
                    например, для имени test, по-умолчанию, будет создано 3 таблицы: test_poly, test_line и test_pint

    --column name   имя поля с геоданными, по умолчанию -- geom
          -c name

    --srid value    задать srid равным `value`, по-умолчанию -1

    --mif file      mif файл. если в качестве имени файла указан `-` или не указано ничего то данные берутся из STDIN
    --mid file      mid файл

    --out file      перенаправить сгенерированные данные в файл file. по-умолчанию все выводится в STDOUT
       -o file

    --noddl         не генерировать ddl для таблиц
    --nodata        не генерировать данные
    --nodrop        не генерировать drop для таблиц перед create
    --dropempty     генерировать drop для созданных таблиц если в них не содержится данных
    --noindex       не создавать индекс по полю геоданных
    --nopoly        заменять полигоны линиями

    --ignore type   игнорировать данные типа `type`. возможные значения: point, line, poly, text
                    например: --ignore text --ignore --line

    --skip column   исключить поле с именем `column`
                    например: --skip id --skip title

    --skipnum i     исключить поле с порядковым номером `i`. номерация полей начинается с 0
                    например: --skipnum 0 --skipnum 3

    --rename c1=c2  переименовать поле `c1` в поле `c2`
                    выполняется после операций skip и skipnum

    --before str    строка `str` попадёт в вывод до любых сгенерированных данных
    --after  str    после всех данных
    --afterddl str  и после ddl
    --extra str     в выражение ddl таблицы
                    например: --extra "title varchar(200) not null default 'test'"

    --div c         коэффициент `c` на который будут разделены все координаты. например: --div 100
    --mul c         коэффициент `c` на который будут умножены все координаты.  например: --mul 100
    --mirrorx       отразить по оси x
    --mirrory       отразить по оси x
    --rotate a      повернуть на `a` градусов по часовой стрелке. если `a` значение отрицательное -- против часовой

    --vacuum        добавлять vacuum analyze для каждой таблицы

    --translit,     транслитерировать ddl из указанной кодировки. возможные значения: KOI8, WIN, DOS, MAC, ISO, UTF-8
           -tr      пробелы будут преобразованы в символы подчеркивания

    --ddltpl file   загрузить шаблон для генерации ddl из файла `file`
         -dt  

    --sqltpl file   загрузить шаблон для генерации sql из файла `file` (медленно!)
         -st
    
    --help, -h      детальная справка по ключам

    --debug, -d     включить отладочный вывод
    };

    exit 0;
}

unless ($conf->mif and $conf->table)
{
    print qq{ 
        некорректно заданы параметры. необходимо указать имя таблицы и имя mif файла:

        $0 [ options ] --table name --mif (file.mif | -) [ --mid file.mid ] [ -o file.sql ]

        для детальной информации по ключам:

        $0 --help
    };

    exit 1;
}

my %ignore = ();

foreach (@{$conf->ignore})
{
    $ignore{lc($_)} = 1;
}

my %skip   = ();
foreach (@{$conf->skip})
{
    $skip{lc($_)} = 1;
}

# TODO переделать имена, непонятные
my @skip_c = (); # номера полей которые будут пропускаться
my %skip_n = (); # номера полей которые будут пропускаться
foreach (@{$conf->skipnum})
{
    $skip_n{$_} = 1;
}

my $extra = '';

unless (0 == @{$conf->extra})
{
    $extra = ',' . join(',', @{$conf->extra});
}

my $mif_fh;

my $string = 0; # номер строки в mid файле 
my $obj    = 0;

# индикатор наличия данных определенного типа
my %has_data = (
                    point => 0,
                    line  => 0,
                    poly  => 0,
                    text  => 0
); 

my %geom = (
                text  => 'POLYGON',
                poly  => 'POLYGON',
                line  => 'LINESTRING',
                point => 'POINT'
);

my $GR = 3.14159265358979 / 180;

my ($ddl, $fld);

my ($ddltpl, $sqltpl);

if ($conf->translit and not $can_translit)
{
    die("unable to transliterate: can't load Convert::Cyrillic module\n");
}

my $t;

if ($can_template)
{
    $t = Template->new();
}
elsif ($conf->sqltpl or $conf->ddltpl)
{
    die("unable to use template files: can't load Template module\n");
}

open($mif_fh, '<' . $conf->mif) or die("can't open $conf->mid\n");

my $csv;
my @info = ();

if ($conf->mid)
{
    if ($can_csv)
    {
        $csv = Text::CSV_XS->new({binary => 1});
        tie(@info, 'Tie::File', $conf->mid) or die("can't open $conf->mid\n");
    }
    else
    {
        die("unable to process mid data: can't load Text::CSV_XS module\n");
    }
}

if ($conf->out)
{
    open(STDOUT, '>', $conf->out) or die("Can't redirect STDOUT into " . $conf->out . ": " . $!);
}

for (@{$conf->before})
{
    print $_, "\n";
}

while (<$mif_fh>)
{
    chomp;

    $string++;

    if (/^Columns\s*([0-9]*)/i)
    {
        ($ddl, $fld) = get_ddl_info($1);

        unless ($conf->noddl)
        {
            generate_ddl($ddl); 

            for (@{$conf->afterddl})
            {
                print $_, "\n";
            }
        }

        define_sql_template() unless ($conf->nodata);

        last;
    }
    elsif (/^Delimiter\s+"([^"]+)"/)
    {
        $csv->sep_char($1) if ($csv);
        next;
    } 
}

while (<$mif_fh>)
{
    last if ($conf->nodata);

    chomp;

    $string++;

    unless ($ignore{poly})
    {
        if (/^(Region|Pline\s+Multiple)\s+([0-9]+)/i)
        {
            region($2);

            debug("$string $obj region/pline multi\t#", $info[$obj], "#\n");
            $obj++;
            next;
        }

        if (/^Pline\s+([0-9]+)/i)
        {
            pline($1);

            debug("$string $obj pline\t#", $info[$obj], "#\n");
            $obj++;
            next;
        }
    }

    unless ($ignore{point})
    {
        if (/^(Point)\s+([^\s]+)\s+([^\s]+).*$/i)
        {
            point($2, $3);

            debug("$string $obj point\t", $info[$obj], "\n");
            $obj++;
            next;
        }
    }

    unless ($ignore{line})
    {
        if (/^Line\s+([^\s]+)\s+([^\s]+)\s+([^\s]+)\s+([^\s]+)/i)
        {
            line($1, $2, $3, $4);

            debug("$string $obj line\t", $info[$obj], "\n");
            $obj++;
            next;
        }
    }

    unless ($ignore{text})
    {
        if (/^Text/i)
        {
            redo unless text();

            debug("$string $obj text\t", $info[$obj], "\n");
            $obj++;
            next;
        }
    }
                                                           
    # debug($_) if ($conf->debug);
}

close($mif_fh);

if ($conf->dropempty and not ($conf->noddl or $conf->nodata))
{
    print "\n";

    for (keys %geom)
    {
        unless ($has_data{$_} or $ignore{$_})
        {
            print "drop table ", $conf->table, "_", $_, ";\n" 
        }
    }
}


for (keys %geom)
{
    if ($has_data{$_} and not $ignore{$_})
    {
        print "\ndelete from ", $conf->table, "_", $_, " where not ST_IsValid(", $conf->column, ");" if ($conf->noinvalid);

        print "\nupdate ", $conf->table, "_", $_, " set ", $conf->column, " = ST_Affine( geom, 1, 0, 0, -1, 0, 0 );" if ($conf->mirrorx);
        print "\nupdate ", $conf->table, "_", $_, " set ", $conf->column, " = ST_Affine( geom, -1, 0, 0, 1, 0, 0 );" if ($conf->mirrory); 

        print "\nupdate ", $conf->table, "_", $_,
               " set ", $conf->column, " = ST_Affine( geom, ",
                                                    " cos(", $conf->rotate * $GR, "), ", 
                                                    " sin(", $conf->rotate * $GR, "), ", 
                                                    "-sin(", $conf->rotate * $GR, "), ", 
                                                    " cos(", $conf->rotate * $GR, "), 0, 0 );" if ($conf->rotate); 

        print "\nvacuum analyze ", $conf->table, "_", $_, ";\n" if ($conf->vacuum);
    }
}


for (@{$conf->after})
{
    print $_, "\n";
}

# ------------------------------------------------------------

sub debug
{
    my $s = join("", @_);
    print STDERR $s if ($conf->debug);
}

sub point
{
    my ($x, $y) = @_;

    $has_data{point} = 1;

    if ($conf->mul)
    {
        ($x, $y) = ($x * $conf->mul, $y, * $conf->mul);
    }

    if ($conf->div)
    {
        ($x, $y) = ($x / $conf->div, $y / $conf->div);
    }

    generate_sql('point', "$x $y");

    debug("-- point\n");
}

sub line
{
    my ($x1, $y1, $x2, $y2) = @_;

    if ($conf->mul)
    {
        ($x1, $y1, $x2, $y2) = ($x1 * $conf->mul, $y1 * $conf->mul, $x2 * $conf->mul, $y2 * $conf->mul);
    }

    if ($conf->div)
    {
        ($x1, $y1, $x2, $y2) = ($x1 / $conf->div, $y1 / $conf->div, $x2 / $conf->div, $y2 / $conf->div);
    }

    $has_data{line} = 1;

    generate_sql('line', "$x1 $y1, $x2 $y2");

    debug("-- line\n");
}

sub text
{
    $has_data{text} = 1;

    debug("-- text $string, $obj ", $info[$obj], "\n");

    my @a = ();

    while (<$mif_fh>)
    {
        unless (/^\s+/)
        {
            warn("incorrect text data met\n");
            return 0;
        }

        chomp;
        
        s/^\s+//;
        s/\s+$//;

        push(@a, $_);

        last if (4 == @a);
    }

    # $a[0] text
    # $a[1] coords
    # $a[2] font
    # $a[3] angle

    my $t = '';
    my $g = 0;
    my $d = '';

    if ($a[0] =~ /^"(.*)"$/)
    {
        $t = $1;
    }
    else
    {
        $t = $a[0];
        warn("potentially incorrect text value met in text data\n");
    }

    if ($a[3] =~ /^Angle\s+(\-?\d+\.?\d*)$/i)
    {
        $g = $1;
    }
    else
    {
        warn("incorrect angle value met in text data\n");
    }

    if ($a[1] =~ /^(\-?\d+\.?\d*)\s+(\-?\d+\.?\d*)\s+(\-?\d+\.?\d*)\s+(\-?\d+\.?\d*)$/)
    {
        if ($g)
        {
            my $cx = (($3 - $1) / 2) + $1;
            my $cy = (($4 - $2) / 2) + $2;

            my @b = ([$1, $2], [$1, $4], [$3, $4], [$3, $2]);

            my @c = ();

            for (@b)
            {
                my ($x1, $y1) = @{$_};

                my $x = ($x1 - $cx) * cos($g * $GR)      + ($y1 - $cy) * sin($g * $GR) + $cx;
                my $y = ($x1 - $cx) * sin($g * $GR) * -1 + ($y1 - $cy) * cos($g * $GR) + $cy;

                push(@c, "$x $y");
            }

            push(@c, $c[0]);

            $d = '(' . join(',', @c) . ')';
        }
        else
        {
            $d = "($1 $2, $1 $4, $3 $4, $3 $2, $1 $2)";
        }
    }
    else
    {
        warn("incorrect geometry value met in text data\n");
        return 2;
    }

    generate_sql('text', $d);

    return 1;
}

sub pline
{
    my ($max) = @_;
    region(1, $max);
}

sub region
{
    my ($i, $max) = @_;

    my @data;

    my $nopoly; # для индикации разомкнутого полигона. если полигон разомкнут, то его геометрия выставляется в line

    if ($conf->nopoly)
    {
        $has_data{line} = 1;
    }
    else
    {
        $has_data{poly} = 1;
    }

    debug("-- pline $i, $max\n");

    for (1..$i)
    {
        my @a;

        while (<$mif_fh>)
        {
            $string++;
            last if (/^$/);

            if (/^\s+/)
            {
               unless ($max)
               {
                    $max = 1;
                    next;
               }
               
               last;
            }

            chomp;

            my ($x, $y) = split(/\s/);

            if ($conf->mul)
            {
                ($x, $y) = ($x * $conf->mul, $y * $conf->mul);
            }

            if ($conf->div)
            {
                ($x, $y) = ($x / $conf->div, $y / $conf->div);
            }

            push(@a, "$x $y");
        }
        
        if (@a)
        {
            $nopoly = 1 if ($a[0] ne $a[@a - 1]);

            push(@data, \@a);
        }
    }

    if (@data)
    {
        if ( $conf->nopoly or $nopoly ) # 1 == @data or 
        {
            map { $_ = join(',', @{$_}) } @data;
        }
        else
        {
            map { $_ = '(' . join(',', @{$_}) . ')' } @data;
        }

        if ($conf->nopoly or $nopoly)
        {
            foreach (@data)
            {
                # на 1 объект Pline Multiple получается несколько записей
                # TODO переделать на MULTILINESTRING?
                generate_sql('line', $_);
            }
        }
        else
        {
            generate_sql('poly', join(',', @data));
        }
    }
}

sub skip_columns
{
    my $s = shift;
    my @a = ();
    my @b = ();

    $s =~ s/\\"/""/g;
    $s =~ s/\\'/'/g;
    $s =~ s/'/''/g;
    $s =~ s/\\/\//g;

    if ($csv->parse($s))
    {
        @a = $csv->fields();
    }
    else
    {
        return undef;
    }

    if (0 == @{$conf->skip})
    {
        @b = @a;
    }
    else
    {
        for (@skip_c)
        {
            delete($a[$_]);
        }

        for (@a)
        {
            push(@b, $_) if (defined($_));
        }
    }

    return join(",", map {"'$_'"} @b);
}

sub generate_sql
{
    my ($type, $data) = @_;

    my $desc = '';

    if ($conf->mid)
    {
        $desc = skip_columns($info[$obj]);

        unless ($desc)
        {
            warn("skip incorrect data at string $obj: $info[$obj]\n", $@);
            return;
        }
    }

    if ($conf->sqltpl and $can_template)
    {
        my $vars = {
                       geom    => \%geom,
                       srid    => $conf->srid,
                       table   => $conf->table,
                       column  => $conf->column,
                       fld     => $fld,
                       type    => $type,
                       data    => $data,
                       desc    => $desc,
                       mid     => ($conf->mid) ? 1 : undef,
        };

        $t->process($sqltpl, $vars);
    }
    else
    {
        print "insert into ", $conf->table, "_", $type, " (", $conf->column;
        print ",", $fld  if ($conf->mid);
        print ") values (GeomFromText('$geom{$type}($data)',", $conf->srid, ")";
        print ", ", $desc if ($conf->mid);
        print ");\n";
    }
}


sub get_ddl_info
{
    my ($col) = @_;

    my @a;
    my @f;

    my $i = 0;
   
    while (<$mif_fh>)
    {
        $string++;
        last unless (/^\s/);

        chomp;

        s/^\s+//;
        s/\s+$//;

        my @t = split(' ', $_);

        # TODO перенести вниз, в блок после пропуска полей ниже переименования. после реализации обработки кириллических имен?
        if ($conf->translit and $can_translit)
        {
            $t[0] = Convert::Cyrillic::cstocs($conf->translit, 'VOL', $t[0]);
            $t[0] =~ tr/"','`~/_/;
        }

        if ($skip_n{$i} or $skip{lc($t[0])})
        {
            push(@skip_c, $i);
        }
        else
        {
            if ($conf->rename)
            {
                foreach my $c (keys %{$conf->rename})
                {
                    $t[0] = $conf->rename->{$c} if ($t[0] =~ /$c/i);
                }
            }

            push(@f, $t[0]);
            push(@a, join(' ', @t)); # push(@a, $_); 
        }

        $i++;

        # $col--;
        # last unless ($col);
    } 

    return join(',', @a), join(',', @f);
}

sub generate_ddl
{
    if ($can_template)
    {
        define_ddl_template();

        my $vars = {
                       geom    => \%geom,
                       ignore  => \%ignore,
                       dim     => 2,
                       srid    => $conf->srid,
                       table   => $conf->table,
                       column  => $conf->column,
                       noindex => $conf->noindex,
                       nodrop  => $conf->nodrop,
                       extra   => $extra,
                       ddl     => $_[0],
        };

        $t->process($ddltpl, $vars);
    }
    else
    {
        foreach my $g (keys %geom)
        {
            unless ($ignore{$g})
            {
                my $t = $conf->table . "_" . $g;

                print 'drop table ',  $t, ';', "\n" unless ($conf->nodrop);

                print 'create table ', $t, ' (', $_[0], $extra, ');', "\n";
                print "select AddGeometryColumn('", $t, "', '", $conf->column, "', ", $conf->srid, ", '", $geom{$g}, "', 2);", "\n";
                print 'create index x__', $t, '__', $conf->column, ' on ', $t, ' using gist (', $conf->column, ');', "\n" unless ($conf->noindex);
            }
        }
    }
}

sub define_ddl_template
{
    if ($conf->ddltpl)
    {
        $ddltpl = $conf->ddltpl;
    }
    else
    {
        $ddltpl = \*DATA;
    }
}

sub define_sql_template
{
    if ($conf->sqltpl and $can_template)
    {
        # insert into [% table _ "_" _ type %] ([% column %][% ", " _ fld IF mid %]) 
        # values (GeomFromText('[% geom.${type} %]([% data %])', [% srid IF srid %][% "-1" UNLESS srid %])[% ", " _ desc IF mid %]);

        $sqltpl = $conf->sqltpl;
    }
}

__DATA__

[% FOREACH g = geom.keys %]

    [% UNLESS ignore.${g} %]

        [% t = table _ "_" _ g %]

        [% UNLESS nodrop %] drop table [% t %]; [% END %]

        create table  [% t %] ([% ddl %][% extra IF extra %]);
        select AddGeometryColumn('[% t %]', '[% column %]', [% srid IF srid %][% "-1" UNLESS srid %], '[% geom.${g} %]', [% dim %]);

        [% UNLESS noindex %] create index x__[% t %]__[% column %] on [% t %] using gist ([% column %]); [% END %]

    [% END %]

[% END %]