#! /bin/sh
#!perl -w # --*- Perl -*--
eval 'exec perl -x $0 ${1+"$@"}'
    if 0;
#------------------------------------------------------------------------------
#$Author: antanas $
#$Date: 2021-04-28 19:35:53 +0300 (Wed, 28 Apr 2021) $
#$Revision: 8738 $
#$URL: svn+ssh://www.crystallography.net/home/coder/svn-repositories/cod-tools/tags/v3.7.0/scripts/cif_mpod_v1_to_v3 $
#------------------------------------------------------------------------------
#*
#* Convert MPOD structures from MPOD dictionary V1 to MPOD dict. V3 based
#* data names.
#*
#* USAGE:
#*    $0 --options input1.cif input*.cif
#**

use strict;
use warnings;
use COD::CIF::Parser qw( parse_cif );
use COD::CIF::Tags::Manage qw( exclude_tag );
use COD::CIF::Tags::Print qw( print_cif );
use COD::SOptions qw( getOptions );
use COD::SUsage qw( usage options );
use COD::ErrorHandler qw( process_warnings
                          process_parser_messages
                          report_message );
use COD::ToolsVersion qw( get_version_string );

my $die_on_error_level = {
    ERROR   => 1,
    WARNING => 0,
    NOTE    => 0
};

my $use_parser = "c";

#* OPTIONS:
#*   --use-perl-parser
#*                     Use development CIF parser written in Perl.
#*   --use-c-parser
#*                     Use faster C/Yacc CIF parser (default).
#*
#*   --help, --usage
#*                     Output a short usage message (this message) and exit.
#*   --version
#*                     Output version information and exit.
#**
@ARGV = getOptions(
    "--use-perl-parser"  => sub { $use_parser = "perl" },
    "--use-c-parser"     => sub { $use_parser = "c" },

    '--options'      => sub { options; exit },
    '--help,--usage' => sub { usage; exit },
    '--version'      => sub { print get_version_string(), "\n"; exit }
);

my @scalar_property_tags = qw(
    _prop_residual_resistivity_ratio
    _prop_residual_resistivity_ratio_high_temperature
    _prop_residual_resistivity_ratio_low_temperature
    _prop_superconducting_critical_temperature_thermodynamic
    _prop_superconducting_critical_temperature_onset
    _prop_superconducting_critical_temperature_onset_90
    _prop_superconducting_critical_temperature_mid_50
    _prop_superconducting_critical_temperature_offset_10
    _prop_superconducting_zero_resistivity_temperature
    _prop_superconducting_resistivity_transition_width
    _prop_magnetic_paramagnetic_critical_temperature_Neel
    _prop_magnetic_paramagnetic_critical_temperature_Neel_transitionwidth
    _prop_magnetic_antiferromagnetic_ordering_temperature_Neel
);

my @property_tags = qw(
    _prop_heat_capacity_C
    _prop_dielectric_permittivity_relative_epsrij
    _prop_dielectric_permittivity_relative_epsrijS
    _prop_dielectric_permittivity_relative_epsrijT
    _prop_dielectric_stiffness_relative_betrijS
    _prop_dielectric_stiffness_relative_betrijT
    _prop_elastic_stiffness_cij
    _prop_elastic_stiffness_cijD
    _prop_elastic_stiffness_cijE
    _prop_elastic_compliance_sij
    _prop_elastic_compliance_sijD
    _prop_elastic_compliance_sijE
    _prop_electric_resistivity_rhoeij
    _prop_electric_remnant_polarisation_Pri
    _prop_electric_coercive_field_Eci
    _prop_internal_friction_Qij-1
    _prop_electromechanical_coupling_kij
    _prop_optical_index_ordinary_no
    _prop_optical_index_extraordinary_ne
    _prop_piezoelectric_gij
    _prop_piezoelectric_eij
    _prop_piezoelectric_hij
    _prop_piezoelectric_dij
    _prop_piezooptic_piij
    _prop_superconducting_critical_field1_Hc1i
    _prop_superconducting_critical_field2_Hc2i
    _prop_superconducting_irreversibility_field_Hirri
    _prop_superconducting_coherence_length_ksii
    _prop_superconducting_penetration_depth_lambdai
    _prop_electrostriction_Dij
    _prop_electrostriction_Dprimeij
    _prop_photoelastic_pij
    _prop_thermal_conductivity_kappaij
    _prop_thermal_diffusivity_kappadij
    _prop_thermal_expansion_alphaij
    _prop_thermal_expansion_Tij
    _prop_thermoelectric_Seebeck_Seij
);

my @condition_tags = qw(
    _prop_conditions_temperature
    _prop_conditions_temperature_range_begin
    _prop_conditions_temperature_range_end
    _prop_conditions_temperature_cycle
    _prop_conditions_pressure
    _prop_conditions_frequency
    _prop_conditions_magnetic_field
    _prop_conditions_wavelength
);

my @measurement_tags = qw(
    _prop_measurement_method
    _prop_measurement_poling
    _prop_frame
);

my @data_tags = qw(
    _prop_data_label
    _prop_data_value
    _prop_data_tensorial_index
);

my @categories = qw(
    prop_dielectric
    prop_elastic
    prop_electric
    prop_electromechanical_coupling
    prop_electrostriction
    prop_frame
    prop_heat_capacity
    prop_internal_friction
    prop_magnetic
    prop_measurement
    prop_optical
    prop_photoelastic
    prop_piezoelectric
    prop_piezooptic
    prop_residual_resistivity
    prop_superconducting
    prop_symmetry
    prop_thermal
    prop_thermoelectric
);

@ARGV = ( "-" ) unless @ARGV;

binmode STDOUT, ':encoding(UTF-8)';
binmode STDERR, ':encoding(UTF-8)';

for my $filename (@ARGV) {

    my $options = { 'parser' => $use_parser, 'no_print' => 1 };
    my ( $data, $err_count, $messages ) = parse_cif( $filename, $options );
    process_parser_messages( $messages, $die_on_error_level );

    if( !@$data ) {
        report_message( {
            'program'   => $0,
            'filename'  => $filename,
            'err_level' => 'WARNING',
            'message'   => 'file seems to be empty'
        }, $die_on_error_level->{'WARNING'} );
        next;
    }

    for my $datablock (@$data) {
        my $values = $datablock->{values};
        my $tags = $datablock->{tags};

        local $SIG{__WARN__} = sub {
            process_warnings( {
                'message'  => @_,
                'program'  => $0,
                'filename' => $filename,
                'add_pos'  => 'data_' . $datablock->{'name'}
            }, $die_on_error_level )
        };

        my @conditions = ();
        for my $condition (@condition_tags) {
            my $condition_key = lc( $condition );
            if( exists $values->{$condition_key} ) {
                push( @conditions, $condition );
            }
        }

        my %condition_data = ();
        my $condition_id = 1;
        my %property_data = ();
        my %property_names = ();
        for my $property (@property_tags) {
            my $property_key = lc( $property );

            if( exists $values->{$property_key} ) {
                my $category = get_category( $property );
                my $property_label = $values->{$property_key}[0];
                $property_names{$category}{$property} = 1;
                for my $i (0..$#{$values->{_prop_data_label}}) {
                    if( $property_label eq $values->{_prop_data_label}[$i] ) {
                        my $tensorial_index =
                            defined $values->{_prop_data_tensorial_index}[$i] ?
                            $values->{_prop_data_tensorial_index}[$i] : ".";
                        my $separator = "";
                        my $condition_key;
                        for (@conditions) {
                            my $idx = 0;
                            if( exists $datablock->{inloop}{$_} ) {
                                $idx = $i
                            }
                            $condition_key .= $separator .
                                $values->{$_}[$idx];
                            $separator = " ";
                        }

                        my $measurement_method = "?";
                        for (qw(_prop_measurement_method)) {
                            if( exists $values->{$_} ) {
                                my $idx = 0;
                                if( exists
                                    $datablock->{inloop}{$_} ) {
                                    $idx = $i
                                }
                                $measurement_method = $values->{$_}[$idx];
                            }
                        }

                        if( defined $condition_key ) {
                            if( !exists $condition_data{$condition_key} ) {
                                $condition_data{$condition_key} =
                                    $condition_id++;
                            }
                            my $condition_label =
                                "_".$category."_condition_label";
                            $property_data
                            {$category}
                            {$condition_key}
                            {$measurement_method}
                            {$tensorial_index}
                            {$condition_label} =
                                $condition_data{$condition_key};
                        }

                        if( !exists $property_data
                            {$category}
                            {defined $condition_key ? $condition_key : ""}
                            {$measurement_method}
                            {$tensorial_index}
                            {$property} ) {
                            $property_data
                                {$category}
                                {defined $condition_key ? $condition_key : ""}
                                {$measurement_method}
                                {$tensorial_index}
                                {$property} =
                                    $values->{_prop_data_value}[$i];
                        } else {
                            warn "WARNING, property '$property' for index "
                                . "'$tensorial_index' "
                                . ($condition_key ? "(at conditions "
                                . "$condition_key) " : "")
                                . "is defined more than once\n";
                        }
                    }
                }
            }
        }
        # Delete version 1 value tags:
        for my $tag (@condition_tags, @property_tags, @data_tags) {
            exclude_tag( $datablock, lc($tag) );
        }
        exclude_tag( $datablock, "_prop_measurement_method" );
        # Print out the rest of the CIF data:
        print_cif( $datablock, {
            exclude_misspelled_tags => 0,
            preserve_loop_order => 1,
            fold_long_fields => 1,
            folding_width => 78,
            dictionary_tags => { map {$_,$_} @{$datablock->{tags}} },
            dictionary_tag_list => $datablock->{tags},
            keep_tag_order => 1,
        });

        # Print out the condition table:
        if( %condition_data ) {
            my %condition_ids;
            while( my ($key, $id) = each %condition_data ) {
                $condition_ids{$id} = $key;
            }
            print "loop_\n";
            print "_prop_conditions_label\n";
            for (@conditions) {
                print $_, "\n";
            }
            for my $key (sort keys %condition_ids) {
                print $key, " ", $condition_ids{$key}, "\n";
            }
        }

        # Print out the collected tensor values if there are any:
        if( %property_data ) {
            for my $category (sort keys %property_data) {
                print "loop_\n";
                print "_${category}_tensorial_index\n";
                print "_${category}_condition_label\n";
                print "_${category}_measurement_method\n";
                for my $key (sort keys %{$property_names{$category}}) {
                    print $key, "\n";
                }
                my $category_data = $property_data{$category};
                for my $condition_value (sort keys %{$category_data}) {
                    for my $method (sort keys %{$category_data->{$condition_value}}) {
                        for my $tensorial_index
                            (sort keys %{$category_data->{$condition_value}{$method}}) {
                                print $tensorial_index, " ";
                                print
                                    defined $condition_data{$condition_value} ?
                                    $condition_data{$condition_value} : "?", " ";
                                print $method;
                                for my $property (sort keys %{$property_names{$category}}) {
                                    if( defined $category_data->{$condition_value}{$method}
                                    {$tensorial_index}{$property} ) {
                                    print " ",
                                    $category_data->{$condition_value}{$method}
                                    {$tensorial_index}{$property};
                                } else {
                                    print " ?";
                                }
                            }
                            print "\n";
                        }
                    }
                }
            }
        }
    }
}

sub get_category
{
    my ( $property ) = @_;

    for my $category (@categories) {
        if( $property =~ /^_${category}_/ ) {
            return $category
        }
    }

    return;
}