#!/usr/bin/perl
# Copyright (c) 2014-2018 Sullivan Beck.  All rights reserved.
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.

###############################################################################
###############################################################################
# This script is the wrapper which is used to harvest and check data of a
# single type.
#
# It first loads the old data.  Then it harvests the new data.  Then it
# compares the new data to the old data and shows the difference in a
# usable way.

require 5.000000;
use warnings;
use strict;

use lib "./lib";

###############################################################################
# GLOBAL VARIABLES
###############################################################################

our %type =
  ( 'country'  => { 'label'   => 'Country',
                    'sets'    => [qw(alpha-2 alpha-3 numeric dom)],
                    'opt'     => '-c' },
    'language' => { 'label'   => 'Language',
                    'sets'    => [qw(alpha-2 alpha-3 term)],
                    'opt'     => '-l' },
    'currency' => { 'label'   => 'Currency',
                    'sets'    => [qw(alpha num)],
                    'opt'     => '-r' },
    'script'   => { 'label'   => 'Script',
                    'sets'    => [qw(alpha num)],
                    'opt'     => '-s' },
    'langext'  => { 'label'   => 'LangExt',
                    'sets'    => [qw(alpha)],
                    'opt'     => '-L' },
    'langvar'  => { 'label'   => 'LangVar',
                    'sets'    => [qw(alpha)],
                    'opt'     => '-V' },
    'langfam'  => { 'label'   => 'LangFam',
                    'sets'    => [qw(alpha)],
                    'opt'     => '-F' },
  );

###############################################################################
# HELP
###############################################################################

our($usage);
my $COM = $0;
$COM =~ s/^.*\///;

my @type = sort keys %type;
$usage=
  "usage: $COM OPTS TYPE
      -h/--help       : Print help.

      -d/--debug      : Run the harvest_data script in the debugger.

TYPE is one of:
   @type
";

###############################################################################
# PARSE ARGUMENTS
###############################################################################

our $type;
our $debug = 0;

while ($_ = shift) {

   (print $usage),   exit  if ($_ eq "-h"   ||  $_ eq "--help");
   $debug = 1,       next  if ($_ eq "-d"   ||  $_ eq "--debug");

   $type = $_;
   last;
}

die $usage  if (@ARGV  ||
                ! $type  ||
                ! exists $type{$type});

############################################################################
# MAIN PROGRAM
############################################################################

our $label    = $type{$type}{'label'};
our @sets     = sort @{ $type{$type}{'sets'} };
our $opt      = $type{$type}{'opt'};
our $main_mod = "Locale::Codes::$label";
our $code_mod = "Locale::Codes::${label}_Codes";
our $file     = "lib/Locale/Codes/${label}_Codes.pm";

print "#"x70,"\n";
print "$label\n";
print "#"x70,"\n";

# If we have $file.bak, restore it so that if we run this multiple times,
# we'll always have the same behavior.

if ( -f "$file.bak" ) {
   system("mv $file.bak $file");
}
our %old      = get_data();

# Now backup the file.

system("cp -p $file $file.bak");

# Harvest the data

my $deb       = ($debug ? "-d" : "");
system("perl $deb ./internal/harvest_data $opt");
our %new      = get_data();

# We want to check to see if there is any HTML in the new file.

print "#"x70,"\n";
print "Suspected HTML in codes:\n\n";
system("egrep '<' $file");

compare("NAMES");

foreach my $set (@sets) {
   compare("SET: $set");
}



############################################################################

sub compare {
   my($grp) = @_;

   my @old  = sort keys %{ $old{$grp} };
   my $old  = @old;
   my @new  = sort keys %{ $new{$grp} };
   my $new  = @new;

   print "#"x70,"\n";
   print "Changes to: $grp:\n";
   print "   Size: $old -> $new\n"   if ($old != $new);
   print "\n";

   while (@old  ||  @new) {
      if ( (@old  &&  ! @new)  ||
           (@old  &&  @new  &&  $old[0] lt $new[0]) ) {
         print "   - $old[0]\n";
         foreach my $val (@{ $old{$grp}{$old[0]} }) {
            print "     - $val\n";
         }
         shift(@old);

      } elsif ( (@new  &&  ! @old)  ||
                (@old  &&  @new  &&  $new[0] lt $old[0]) ) {
         print "   + $new[0]\n";
         foreach my $val (@{ $new{$grp}{$new[0]} }) {
            print "     + $val\n";
         }
         shift(@new);

      } else {
         my $key = shift(@old);
         shift(@new);

         my @diff;
         my @oval = sort @{ $old{$grp}{$key} };
         my @nval = sort @{ $new{$grp}{$key} };

         while (@oval  ||  @nval) {

            if ( (@oval  &&  ! @nval)  ||
                 (@oval  &&  @nval  &&  $oval[0] lt $nval[0]) ) {
               push(@diff,"- $oval[0]");
               shift(@oval);
               next;

            } elsif ( (@nval  &&  ! @oval)  ||
                      (@oval  &&  @nval  &&  $nval[0] lt $oval[0]) ) {
               push(@diff,"+ $nval[0]");
               shift(@nval);
               next;

            } else {
               shift(@oval);
               shift(@nval);
               next;
            }
         }

         if (@diff) {
            print "   * $key\n";
            foreach my $diff (@diff) {
               print "     $diff\n";
            }
         }
      }
   }
}

sub get_data {
   my @in = `./internal/print_curr_data $code_mod`;
   chomp @in;

   my %in;
   my $grp = "";
   my $ele = "";

   LINE:
   while (@in) {
      my $line = shift(@in);

      if ($line eq "NAMES"  ||
          $line =~ /^SET: /) {
         $grp = $line;
         next LINE;
      }

      if ($line =~ /^ /) {
         $line =~ s/^ *//;
         push @{ $in{$grp}{$ele} },$line;

      } else {
         $ele = $line;
         $in{$grp}{$ele} = [];
      }
   }

   return %in;
}


# Local Variables:
# mode: cperl
# indent-tabs-mode: nil
# cperl-indent-level: 3
# cperl-continued-statement-offset: 2
# cperl-continued-brace-offset: 0
# cperl-brace-offset: 0
# cperl-brace-imaginary-offset: 0
# cperl-label-offset: 0
# End: