#!/usr/bin/perl

use POSIX qw(getcwd);
use warnings 'all';
use strict;

$| = 1;

###############################################################################
# PREREQUISITES
###############################################################################

use I18N::LangTags::Detect;
use Locale::VersionedMessages::lm;

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

our $default_locale   = "en_US";
our $default_dir      = "lib";

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

use vars qw($COM);

BEGIN {
   $COM = $0;
   $COM =~ s/^.*\///;
}

our $usage=
  "usage: $COM [OPTIONS]

      Exactly one of the following operations may be used:

      -h/--help             : Print help.

      -c/--create           : Create a new set of message.
                              Required options: -s
                              Other options: -L, -d

      -l/--lexicon          : Create a new lexicon.
                              Required options: -s
                              Other options: -L, -d

      -m/--message          : Add one or more messages to one
                              or all lexicons.
                              Required options: -s, -M
                              Other options: -L, -d, -U

      -u/--update           : Update all messages that are
                              out-of-date in a single locale.
                              Required options: -s, -L
                              Other options: -d, -U

      Options:

      -s/--set SET          : Specifies the message set to work
                              with.  SET must be alphanumeric or
                              underscore.

      -d/--dir DIR          : Specifies the directory where the
                              internationaliziation modules
                              live. There will be a directory
                              structure:
                                 DIR/lib/Locale/VersionedMessages
                              If DIR is not given, it defaults
                              to the current directory.

      -L/--locale LOCALE    : Specifies the default locale to
                              work with.

      -M/--msgid MSGID      : Work with the message ID given.

      -U/--no-update        : By default, when a message is updated
                              in a lexicon, the version is updated.
                              With this option, the version will be
                              left unmodified (though the message
                              will be updated).

";

# #pod

# #head1 NAME

# lm_admin - simple tool for managine Locale::VersionedMessages lexicons

# #head1 SYNOPSIS

# This tool can be used to maintain the lexicon files used by the
# Locale::VersionedMessages perl module.

#    lm_admin [OPERATION] [OPTIONS]

# #head1 DESCRIPTION

# The Locale::VersionedMessages module allows translation tables (i.e. lexicons) for
# a set of message to be stored in perl modules to be used in a localized
# program.

# This tool allows you to create a new set of messages, a new lexicon (i.e.
# a new locale which the messages can be translated into), as well as add
# or update any information in the lexicons.

# Operations available are:

# =over 5

# =item -h, --help

# Print online help.

# =item -c, --create

# Create the infrastructure (i.e. the framework of a set of perl modules) which
# will contain the new set of messages.

# The -s/--set option is required.  The -L/--locale and -d/--dir options
# may be given.

# =item -l, --lexicon

# This can be used to create a perl module containing a new translation of a
# set of messages.

# The -s/--set option is required.  The -L/--locale and -d/--dir options
# may be given.

# =item -m, --message

# This can be used to add or update a message in the set.

# The -s/--set and -M/--msgid options are required.  The -L/--locale, -d/--dir,
# and -U/--no-update options may be given.

# =item -u, --update

# This can be used to update all messages in a single locale that are out-of-date.

# The -s/--set option is required.  The -L/--locale, -d/--dir, and
# -U/--no-update options may be given.

# =back

# The following options are available for the above operations:

# =item -s, --set SET

# This can be used to specify the name of the set of messages.  SET must
# be composed of characters that can make up the name of a perl module.
# It is recommended that it be alphanumeric or underscore (though other
# characters may work).

# =item -d, --dir DIR

# This option is used to specify the directory where the perl module
# hierarchy will live.  DIR must already exist, and a new set
# of message modules will live in:

#    DIR/Locale/VersionedMessages/Sets/SET.pm
#    DIR/Locale/VersionedMessages/Sets/SET/LOCALE.pm

# If this option is not given, DIR defaults to the current directory.

# =item -L, --locale LOCALE

# This specifies the name of the locale to work with.  If you are creating
# a new set of messages, this will be the default locale for that set.

# Some operations (such as adding a message) could be done which apply
# to multiple existing locales.  In this case, LOCALE could be the word
# 'default' which refers to the default locale, or 'all' which refers to
# all locales defined for that set of messages.

# =item -M, --msgid MSGID

# Operations that work on a message require this option to specify
# which message to work on.

# MSGID is the string which will be used to refer to the message
# in the localized program.

# =item -U, --no-update

# One feature unique to Locale::VersionedMessages is that it keeps track of a
# version number for every message in every locale.  When you update a
# message in the default locale, the version number is incremented.
# When you add or update a message in another locale, it is set to the
# version in the default locale.

# This allows you to easily see which messages are out-of-date with
# respect to the default locale.

# If this option is given, the version is not changed.  This would only
# be done if the change did not impact the actual translation (for
# example, you are fixing a typo or spelling error, but not actually
# changing the text).

# This would allow you to make simple corrections to the default locale
# without flagging all other locales as out-of-date, or making a similar
# simple correction to another locale without actually comparing it to
# the default locale (which might have changed in more extensive ways).

# #head1 KNOWN BUGS

# None known.

# #head1 BUGS AND QUESTIONS

# Please refer to the Locale::VersionedMessages documentation for information on
# submitting bug reports or questions to the author.

# #head1 SEE ALSO

# Locale::VersionedMessages

# #head1 LICENSE

# This script is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

# #head1 AUTHOR

# Sullivan Beck (https://github.com/SBECK-github/)

# =cut

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

my($op,$op_set,$op_dir,$op_locale,$op_msgid,$op_noupdate);
$op_noupdate = 0;

while ($_  = shift) {
   (print $usage),         exit  if ($_ eq "-h"  ||  $_ eq "--help");

   $op        = "create",  next  if ($_ eq "-c"  ||  $_ eq "--create");
   $op        = "lexicon", next  if ($_ eq "-l"  ||  $_ eq "--lexicon");
   $op        = "message", next  if ($_ eq "-m"  ||  $_ eq "--message");
   $op        = "update",  next  if ($_ eq "-u"  ||  $_ eq "--update");

   $op_set    = shift,     next  if ($_ eq "-s"  ||  $_ eq "--set");
   $op_dir    = shift,     next  if ($_ eq "-d"  ||  $_ eq "--dir");
   $op_locale = shift,     next  if ($_ eq "-L"  ||  $_ eq "--locale");
   $op_msgid  = shift,     next  if ($_ eq "-M"  ||  $_ eq "--msgid");
   $op_noupdate = 1,       next  if ($_ eq "-U"  ||  $_ eq "--no-update");

   die $usage;
}

die $usage  if (! $op);

$op_dir    = $default_dir  if (! $op_dir);
if (! -d $op_dir) {
   die "ERROR: directory does not exist: $op_dir\n";
}
eval "use lib \"$op_dir\"";

if ($op eq "message") {
   $op_locale = "all"                             if (! $op_locale);
} elsif ($op eq "update") {
   die "ERROR: --locale option required.\n"       if (! $op_locale);
} else {
   $op_locale = I18N::LangTags::Detect::detect()  if (! $op_locale);
   $op_locale = $default_locale                   if (! $op_locale);
}

die "ERROR: no message set specified.\n"  if (! $op_set);

die "ERROR: no message ID specified.\n"  if ($op eq "message"  &&  ! $op_msgid);

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

set    ($op_set,$op_dir,$op_locale)               if ($op eq "create");
lexicon($op_set,$op_dir,$op_locale)               if ($op eq "lexicon");
message($op_set,$op_dir,$op_locale,$op_msgid,
        $op_noupdate)                             if ($op eq "message");
update ($op_set,$op_dir,$op_locale,$op_noupdate)  if ($op eq "update");

###############################################################################
# OPERATIONS
###############################################################################

sub set {
   my($set,$dir,$def_locale) = @_;

   Locale::VersionedMessages::lm::_set_create($set,$dir,$def_locale);
   Locale::VersionedMessages::lm::_lexicon_create($set,$dir,$def_locale);
}

sub lexicon {
   my($set,$dir,$new_locale) = @_;

   my($set_messages,$def_locale,@oth_locale) =
     Locale::VersionedMessages::lm::_set_read($set,$dir);
   Locale::VersionedMessages::lm::_lexicon_create($set,$dir,$new_locale);
   Locale::VersionedMessages::lm::_set_write($set,$dir,$set_messages,$def_locale,
                                    sort(@oth_locale,$new_locale));
}

sub message {
   my($set,$dir,$locale,$msgid,$noupdate) = @_;

   my($set_messages,$def_locale,@oth_locale) =
     Locale::VersionedMessages::lm::_set_read($set,$dir);

   # Update the set description
   #
   # If the message is brand new, we must be updating the default
   # locale.

   my $update_set = _message_desc(1,$set,$dir,$set_messages,$msgid,$def_locale,
                                  @oth_locale);
   Locale::VersionedMessages::lm::_set_write($set,$dir,$set_messages,$def_locale,
                                    @oth_locale)
     if ($update_set);

   if ($update_set eq 'new') {
      if ($locale ne 'default'  &&
          $locale ne 'all'      &&
          $locale ne $def_locale) {
         die "ERROR: for a new message ID, the locale must be 'all',\n" .
             "       'default', or the default locale.\n";
      }
   }

   # What locale(s) are we updating?

   my(@locale);
   if      ($locale eq 'default') {
      @locale = ($def_locale);
   } elsif ($locale eq 'all') {
      @locale = ($def_locale,@oth_locale);
   } else {
      @locale = ($locale);
   }

   my %locale = map { $_,1 } ($def_locale,@oth_locale);

   foreach my $l (@locale) {
      if (! exists $locale{$l}) {
         die "ERROR: locale not defined for this set: $l\n";
      }
   }

   # Add/update the message in the lexicons.

   my $def_messages = Locale::VersionedMessages::lm::_lexicon_read($set,$dir,$def_locale);
   foreach my $locale (@locale) {
      my $loc_messages = ($locale eq $def_locale ? $def_messages :
                          Locale::VersionedMessages::lm::_lexicon_read($set,$dir,$locale));
      my $op = _message_lexicon($locale,$def_locale,$set_messages,$def_messages,
                                $loc_messages,$msgid,$noupdate);

      if      ($op eq 'add_def'  ||  $op eq 'upd_def') {
         Locale::VersionedMessages::lm::_lexicon_write($set,$dir,$def_locale,$def_messages);
      } elsif ($op eq 'add_loc'  ||  $op eq 'upd_loc') {
         Locale::VersionedMessages::lm::_lexicon_write($set,$dir,$locale,$loc_messages);
      }
   }
}

sub update {
   my($set,$dir,$locale,$noupdate) = @_;

   # Get the default locale info, and the locale you're working
   # with (which must not be the default locale).

   my($set_messages,$def_locale,@oth_locale) =
     Locale::VersionedMessages::lm::_set_read($set,$dir);
   if ($locale eq $def_locale) {
      print "INFO: the --update option only applies to locales other\n" .
            "      than the default locale.\n";
      exit;
   }

   my %locale = map { $_,1 } @oth_locale;
   if (! exists $locale{$locale}) {
      die "ERROR: locale not defined for this set: $locale\n";
   }

   my $def_messages = Locale::VersionedMessages::lm::_lexicon_read($set,$dir,$def_locale);
   my $loc_messages = Locale::VersionedMessages::lm::_lexicon_read($set,$dir,$locale);
   my $updated      = 0;

   MSGID:
   foreach my $msgid (sort keys %$def_messages) {

      # Does this message need to be updated?

      my $def_vers   = $$def_messages{$msgid}{'vers'};
      my $loc_vers   = (exists $$loc_messages{$msgid} ?
                        $$loc_messages{$msgid}{'vers'} : 0);

      next MSGID if ($loc_vers == $def_vers);

      # Update the message.

      _message_desc(0,$set,$dir,$set_messages,$msgid,$def_locale,@oth_locale);
      my $op = _message_lexicon($locale,$def_locale,$set_messages,$def_messages,
                                $loc_messages,$msgid,$noupdate);
      $updated = 1  if ($op);
   }

   if ($updated) {
      Locale::VersionedMessages::lm::_lexicon_write($set,$dir,$locale,$loc_messages);
   }
}

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

# Create/update/display the message description in the set.
#
# If $update is 1, the description is being added/updated.  Otherwise,
# it's just being displayed.
#
sub _message_desc {
   my($update,$set,$dir,$messages,$msgid,$def_locale,@oth_locale) = @_;

   # If we're not adding/update, it must exist.

   if (! $update  &&  ! exists $$messages{$msgid}) {
      die "ERROR: message ID does not exist: $msgid\n";
   }

   # Get the current description (if any) and display it.

   my ($desc,$d,@vals,$new);
   if (exists $$messages{$msgid}) {

      $desc = $$messages{$msgid}{'desc'}   if (exists $$messages{$msgid}{'desc'});
      my $d = $desc;
      $d    = "*** NO DESCRIPTION ***"     if (! $d);
      @vals = @{ $$messages{$msgid}{'vals'} }
                                           if (exists $$messages{$msgid}{'vals'});

      print "="x70,"\n" .
            "The current message definition is:\n" .
            "   Message ID:  $msgid\n" .
            "   Description: $d\n";
      print "   Values     : @vals\n"  if (@vals);
      print "\n";

      $new = 0;
   } else {
      print "="x70,"\n" .
            "Adding the following message:\n" .
            "   Message ID:  $msgid\n" .
            "\n";

      $new = 1;
   }

   my $update_desc = '';
   if ($update  &&  ! $new) {
      my $c = _char_prompt('Is this correct? (y/n)','y','n');
      $update_desc = 'update'  if ($c eq 'n');
   } elsif ($new) {
      $update_desc = 'new';
   }

   # If we are creating a new message, or if we are updating the message
   # description, do it now.

   if ($update_desc) {
      print
        "*"x20 . "\n" .
        "Enter the description on a single line.  If the line is empty, the\n" .
        "description will be erased.  If a period (.) is entered, the existing\n" .
        "description will be used.\n" .
        "\n";
      my $in = <STDIN>;
      chomp($in);
      print "\n";

      if ($in eq '') {
         $desc = '';
      } elsif ($in ne '.') {
         $desc = $in;
      }

      print
        "*"x20 . "\n" .
        "Enter the values that will be substituted in the string.  This is a\n" .
        "comma-separated list of values.  If the line is empty, no values will\n" .
        "be used.  If a period (.) is entered, the existing list will be used.\n" .
        "\n";
      $in = <STDIN>;
      chomp($in);
      print "\n";

      if ($in eq '') {
         @vals = ();
      } elsif ($in ne '.') {
         @vals = split(/\s*,\s*/,$in);
      }

      $$messages{$msgid}{'desc'} = $desc;
      if (@vals) {
         $$messages{$msgid}{'vals'} = [ @vals ];
      } else {
         delete $$messages{$msgid}{'vals'};
      }
   }

   return $update_desc;
}

# Add/update a lexicon message
#
sub _message_lexicon {
   my($locale,$def_locale,
      $set_messages,$def_messages,$loc_messages,
      $msgid,$noupdate) = @_;

   #
   # Find out whether we're adding or updating, and which lexicon.
   #

   my $def_vers     = $$def_messages{$msgid}{'vers'}
     if (exists $$def_messages{$msgid}{'vers'});
   my $def_text     = $$def_messages{$msgid}{'text'}
     if (exists $$def_messages{$msgid}{'text'});
   my $loc_vers     = $$loc_messages{$msgid}{'vers'}
     if (exists $$loc_messages{$msgid}{'vers'});
   my $loc_text     = $$loc_messages{$msgid}{'text'}
     if (exists $$loc_messages{$msgid}{'text'});

   my $op;
   if (! defined($def_text)  ||  $def_text eq '') {
      # Adding a message to the default locale
      if ($locale ne $def_locale) {
         die "ERROR: message not correctly defined in default locale.\n";
      }
      $op = 'add_def';

   } elsif ($locale eq $def_locale) {
      # Updating a message in the default locale
      $op = 'upd_def';

   } elsif (! defined($loc_text)  ||  $loc_text eq '') {
      # Adding a message to another locale
      $op = 'add_loc';

   } else {
      # Updating a message in another locale
      $op = 'upd_loc';
   }

   #
   # Print the message in the default/current locale(s)
   #

   if ($op ne 'add_def') {
      print "*"x20 . "\n" .
            "The message in the default locale is:\n" .
            "   Locale: $def_locale\n" .
            "\n" .
            $def_text .
            "\n";
   }

   if ($op eq 'upd_loc') {
      print "*"x20 . "\n" .
            "The message in currently in the lexicon is:\n" .
            "   Locale: $locale\n" .
            "\n" .
            $loc_text .
            "\n";
   } elsif ($op eq 'add_loc') {
      print "*"x20 . "\n" .
            "Adding message for the the current locale:\n" .
            "   Locale: $locale\n" .
            "\n";
   } elsif ($op eq 'add_def') {
      print "*"x20 . "\n" .
            "Adding message for the the default locale:\n" .
            "   Locale: $def_locale\n" .
            "\n";
   }

   #
   # Get the new version of the message
   #

   my @line;
   print
     "Enter the text of the message.  Blank lines are allowed.  To end, enter a\n" .
     "line containg only of a period (.).  If no text is entered, any existing\n" .
     "value will be kept.\n " .
     "\n";
   while (1) {
      my $line = <STDIN>;
      last  if ($line eq ".\n");
      push(@line,$line);
   }

   return "" if (! @line);
   my $text = join("",@line);

   #
   # Update the version number
   #

   if      ($op eq 'add_def') {
      # Noupdate is ignored.  When we add a new version to the default
      # locale, it's always version 2.
      $$def_messages{$msgid} = { 'vers' => 2,
                                 'text' => $text, };

   } elsif ($op eq 'upd_def') {
      $$def_messages{$msgid}{'vers'}++  if (! $noupdate);
      $$def_messages{$msgid}{'text'} = $text;

   } elsif ($op eq 'add_loc') {
      # If $noupdate, we'll add a message at version 1 (which is always
      # out-of-date since default locales start at 2).
      $$loc_messages{$msgid}{'vers'} = ($noupdate ? 1 : $def_vers);
      $$loc_messages{$msgid}{'text'} = $text;

   } else {
      $$loc_messages{$msgid}{'vers'} = $def_vers  if (! $noupdate);
      $$loc_messages{$msgid}{'text'} = $text;
   }

   return $op;
}

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

sub _char_prompt {
   my($prompt,@chars) = @_;
   my %chars = map { $_,1 } @chars;

   while (1) {
      print "$prompt ";
      my $c = _getone();
      print "$c\n";
      if (exists $chars{$c}) {
         print "\n";
         return $c;
      }
   }
}

#
# From O'Reilly's Programming Perl book
#
BEGIN {
   use POSIX qw(:termios_h);

   my $fd_stdin = fileno(STDIN);

   my $term     = POSIX::Termios->new();
   $term->getattr($fd_stdin);
   my $oterm    = $term->getlflag();

   my $echo     = ECHO | ECHOK | ICANON;
   my $noecho   = $oterm & ~$echo;

   sub _cbreak {
      $term->setlflag($noecho);
      $term->setcc(VTIME, 1);
      $term->setattr($fd_stdin, TCSANOW);
   }

   sub _cooked {
      $term->setlflag($oterm);
      $term->setcc(VTIME, 0);
      $term->setattr($fd_stdin, TCSANOW);
   }

   sub _getone {
      my $key = '';
      _cbreak();
      sysread(STDIN, $key, 1);
      _cooked();
      return $key;
   }
}

END { _cooked() }

# 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:
