#!/usr/bin/perl

# Copyright (C) 2022 Bruno Postle <bruno@postle.net>
#
# ifcmerge is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# ifcmerge is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

use strict;
use warnings;
use DateTime;
use DateTime::TimeZone;
use 5.010;

die "Usage: $0 base.ifc local.ifc remote.ifc merged.ifc" unless scalar(@ARGV) == 4;
my @errors;

my $base = Ifc->new;
$base->load($ARGV[0]);
my $local = Ifc->new;
$local->load($ARGV[1]);
my $remote = Ifc->new;
$remote->load($ARGV[2]);
my $merged = Ifc->new;
$merged->load($ARGV[0]); # note: initially the same as base

$local->compare($base);
$remote->compare($base);

# if both files have added entities, renumber local added entities to make space

my $offset = $remote->last - $base->last;
my $max = $base->last;
if ($offset > 0)
{
    for my $id (reverse ($local->added_ids))
    {
        my $text = $local->{file}->{$id};
        $text =~ s/#([0-9]+)/'#'. _add_offset($1, $max, $offset)/ge;
        $local->{file}->{_add_offset($id, $max, $offset)} = $text;
        delete $local->{file}->{$id};
    }
    for my $id ($local->modified_ids)
    {
        my $text = $local->{file}->{$id};
        $text =~ s/#([0-9]+)/'#'. _add_offset($1, $max, $offset)/ge;
        $local->{file}->{$id} = $text;
    }
}

$local->compare($base); # local may have been renumbered

# copy added entities

for my $id ($local->added_ids)
{
    $merged->{file}->{$id} = $local->{file}->{$id};
}
for my $id ($remote->added_ids)
{
    $merged->{file}->{$id} = $remote->{file}->{$id};
}

# delete deleted entities

for my $id ($local->deleted_ids)
{
    if (defined $remote->{modified}->{$id})
    {
        push @errors, "$ARGV[1] deleted entity #$id modified in $ARGV[2]!";
    }
    else
    {
        delete $merged->{file}->{$id};
    }
}
for my $id ($remote->deleted_ids)
{
    if (defined $local->{modified}->{$id})
    {
        push @errors, "$ARGV[2] deleted entity #$id modified in $ARGV[1]!";
    }
    else
    {
        delete $merged->{file}->{$id};
    }
}

# update modified entities
# FIXME this will fail if the final entity has been deleted and a new entity created with the same id

for my $id ($local->modified_ids)
{
    my ($base_class, @base_attr) = $base->class_attributes($id);
    my ($local_class, @local_attr) = $local->class_attributes($id);
    push @errors, "entity #$id class changed in $ARGV[1]!" if ($base_class ne $local_class);
    $merged->{file}->{$id} = $local->{file}->{$id};
}
for my $id ($remote->modified_ids)
{
    my ($base_class, @base_attr) = $base->class_attributes($id);
    my ($remote_class, @remote_attr) = $remote->class_attributes($id);
    push @errors, "entity #$id class changed in $ARGV[2]!" if ($base_class ne $remote_class);
    if (defined $local->{modified}->{$id})
    {
        # entity is modified in both, try and merge attributes
        my ($local_class, @local_attr) = $local->class_attributes($id);
        my @merged_attr;
        for my $i (0 .. scalar(@base_attr) -1)
        {
            if ($base_attr[$i] eq $local_attr[$i]
            and $base_attr[$i] eq $remote_attr[$i])
            {
                # simple case attribute not modified
                $merged_attr[$i] = $base_attr[$i];
            }
            elsif ($base_attr[$i] ne $local_attr[$i]
               and $base_attr[$i] ne $remote_attr[$i]
               and $local_attr[$i] ne $remote_attr[$i])
            {
                # attribute modified in local and remote
                if ($base_attr[$i] =~ /^\([#,0-9]*\)$/)
                {
                    # attribute is a list of ids
                    my @base_ids = $base_attr[$i] =~ /(#[0-9]+)/g;
                    my @local_ids = $local_attr[$i] =~ /(#[0-9]+)/g;
                    my @remote_ids = $remote_attr[$i] =~ /(#[0-9]+)/g;
                    my (%base_ids, %local_ids, %remote_ids, %merged_ids);
                    $base_ids{$_} = 1 for @base_ids;
                    $local_ids{$_} = 1 for @local_ids;
                    $remote_ids{$_} = 1 for @remote_ids;
                    for my $local_id (@local_ids)
                    {
                        # id exists in local
                        $merged_ids{$local_id} = 1;
                    }
                    for my $remote_id (@remote_ids)
                    {
                        # id exists in remote
                        $merged_ids{$remote_id} = 1;
                    }
                    for my $base_id (@base_ids)
                    {
                        $merged_ids{$base_id} = 1;
                        if (not defined $local_ids{$base_id} or
                            not defined $remote_ids{$base_id})
                        {
                            # id has been deleted in local or remote
                            delete $merged_ids{$base_id};
                        }
                    }
                    # FIXME this should be a numeric sort
                    $merged_attr[$i] = '('. join(',', sort(keys %merged_ids)) .')';
                }
                else
                {
                    # attribute is not mergeable
                    $merged_attr[$i] = $local_attr[$i];
                    push @errors, "entity #$id attribute [". ($i +1) ."] conflict!";
                }
            }
            elsif ($base_attr[$i] ne $local_attr[$i])
            {
                # local only modified, or local and base both identically modified
                $merged_attr[$i] = $local_attr[$i];
            }
            else
            {
                # remote only modified
                $merged_attr[$i] = $remote_attr[$i];
            }
        }
        $merged->{file}->{$id} = $base_class .'('. join(',', @merged_attr) .')';
    }
    else
    {
        # entity is modified in remote only
        $merged->{file}->{$id} = $remote->{file}->{$id};
    }
}

die join "\n", @errors, '' if scalar @errors;

say "Success!";

$merged->write($ARGV[3]);

0;

sub _add_offset
{
    my ($id, $max, $offset) = @_;
    return $id + $offset if $id > $max;
    return $id;
}

package Ifc;

sub new
{
    my $class = shift;
    my $self = {headers => [], file => {}, added => {}, deleted => {}, modified => {}};
    bless $self, $class;
    return $self;
}

sub load
{
    my $self = shift;
    my $path = shift;
    open my $IN, '<', $path or die "$!";
    for my $line (<$IN>)
    {
        if ($line =~ /^#([0-9]+)=(.*);/)
        {
            $self->{file}->{$1} = $2;
        }
        elsif ($line =~ /\/\*.*\*\//)
        {
            # we discard comments
        }
        else
        {
            push @{$self->{headers}}, $line;
        }
    }
    close $IN;
}

sub write
{
    my $self = shift;
    my $path = shift;
    my $dt = DateTime->now;
    my $tz = DateTime::TimeZone->new(name => 'local');
    my $tz_offset = $tz->offset_as_string($tz->offset_for_datetime($dt));
    $tz_offset =~ s/(..)(..)$/$1:$2/;
    my $now = $dt.$tz_offset;
    open my $OUT, '>', $path or die "$!";
    for my $line (@{$self->{headers}})
    {
        if ($line =~ /^FILE_NAME/)
        {
            $line =~ s/....-..-..T..:..:..[+-]..:../$now/;
        }
        print $OUT $line;
        if ($line =~ /^DATA;/)
        {
            for my $id ($self->file_ids)
            {
                say $OUT "#$id=". $self->{file}->{$id} .";";
            }
        }
    }
}

sub compare
{
    my ($self, $other) = @_;
    $self->{added} = {};
    $self->{modified} = {};
    $self->{deleted} = {};
    for my $id ($self->file_ids)
    {
        if (not defined $other->{file}->{$id})
        {
            $self->{added}->{$id} = 1;
        }
        elsif ($self->{file}->{$id} ne $other->{file}->{$id})
        {
            $self->{modified}->{$id} = 1;
        }
    }
    for my $id ($other->file_ids)
    {
        if (not defined $self->{file}->{$id})
        {
            $self->{deleted}->{$id} = 1;
        }
    }
}

sub last
{
    my $self = shift;
    my @sorted = sort {$a <=> $b} $self->file_ids;
    return $sorted[-1];
}

sub file_ids
{
    my $self = shift;
    return sort {$a <=> $b} keys %{$self->{file}};
}

sub added_ids
{
    my $self = shift;
    return sort {$a <=> $b} keys %{$self->{added}};
}

sub modified_ids
{
    my $self = shift;
    return sort {$a <=> $b} keys %{$self->{modified}};
}

sub deleted_ids
{
    my $self = shift;
    return sort {$a <=> $b} keys %{$self->{deleted}};
}

sub class_attributes
{
    my $self = shift;
    my $id = shift;
    my ($class, $attributes) = $self->{file}->{$id} =~ /^([_[:alnum:]]+)\((.*)\)$/;
    my @attributes = _dissemble($attributes);
    return $class, @attributes;
}

sub _dissemble
{
    my $text = shift;
    my $NAME = '[_[:alnum:]]+';
    my $SPACE = '[[:space:]]*';
    my $COMMA = "[[:space:],]+";
    my $QUOTED = "'.*?'";
    my $SIMPLE = "[^',)(]+";
    my $PARAMVALUE = "$NAME\\(.*?\\)";
    my $PARAMQUOTED = "$NAME\\('.*?'\\)";
    my $BRACKETED = "\\((?:$COMMA|$PARAMQUOTED|$PARAMVALUE|$QUOTED|$SIMPLE)*\\)";
    my @tokens = $text =~ /($PARAMQUOTED|$PARAMVALUE|^\(.*\)$|$BRACKETED|$QUOTED|$SIMPLE)/xg;
    my @out;
    for my $token (@tokens)
    {
        $token =~ s/^$COMMA//x;
        $token =~ s/$SPACE$//x;
        push @out, $token;
    }
    return @out;
}