File Coverage

blib/lib/Mojolicious/Plugin/Localize/Command/localize.pm

Criterion	Covered	Total	%
statement	88	95	92.6
branch	25	32	78.1
condition	21	31	67.7
subroutine	9	10	90.0
pod	1	1	100.0
total	144	169	85.2

package Mojolicious::Plugin::Localize::Command::localize;
use Mojo::Base 'Mojolicious::Command';
use Mojo::Util qw/quote encode/;
use Mojo::Date;
use Getopt::Long qw(GetOptionsFromArray :config no_auto_abbrev no_ignore_case);

# TODO:
#   Probably do:
#   http://irclog.perlgeek.de/mojo/2016-09-22#i_13257554

has description => 'Generate dictionary files for Localize';
has usage       => sub { shift->extract_usage };

our $SPECIAL = '!SPECIAL!'; # Special locale

use constant DEBUG => $ENV{MOJO_LOCALIZE_DEBUG} || 0;

has [qw/base lang controller/];


# Generate dictionary template
sub run {
  my ($self, $lang, @args) = @_;

  $self->lang($lang);

  my $app = $self->app;

  GetOptionsFromArray \@args,
    'b|base=s'   => \(my $base = 'en'),
    'o|output=s' => \(my $output = '');

  # Unknown command
  print $self->usage and return unless $self->lang;

  # Set base language
  $self->base($base);

  # Initialize key store
  $self->{keys} = {};

  # Get generated dictionary
  my $dict = $app->localize->dictionary;

  # Set controller
  $self->controller($app->build_controller);

  # Setting an unlikely locale
  $self->controller->stash('localize.locale' => [$SPECIAL]);

  # Recursive investigate the dictionary
  $self->_investigate($dict, [], 0);

  my $data = '# Dictionary template generated ';
  $data .= Mojo::Date->new(time);
  $data .= "\n\n{\n" . $self->_filter->_print . "};\n";

  $output ||= $app->moniker . '.' . $self->lang . '.dict';

  # Generate file
  if (-e $output) {
    warn quote($output) . " already exists and is not overwritten.\n\n"
  }
  elsif ($self->write_rel_file($output, encode('UTF-8', $data))) {
    say quote($output) . " written.\n";
  };
  print "\n";
};


# Investigate dictionary entry and check for usage
sub _investigate {
  my ($self, $dict, $path, $level) = @_;

  if (!ref $dict || ref $dict eq 'SCALAR' || ref $dict eq 'CODE') {

    # Check elements of the path
    my @elements = @{$path}[0..$level - 1];

    # Key is not localed
    return unless grep /[\*\+]/, @elements;

    # Join the missing key
    my $key = join('_', @elements);

    $self->{keys}->{$key} = $dict;

    return;
  }

  elsif (ref $dict eq 'ARRAY') {
    warn 'Arrays are not valid dictionary values';
    return;
  };

  # Set local $_ to nested helber for preferred subroutines
  local $_ = $self->controller->localize;

  # Define the example branch
  my $locale_example;

  # There is a locale branch
  my $loc_act;
  if (($loc_act = $dict->{_}) &&
        (ref($loc_act) eq 'CODE') &&
        ($loc_act = $dict->{_}->($self->controller)) &&
        (ref($loc_act) eq 'ARRAY') &&
        ($loc_act->[0] eq $SPECIAL)) {

    # The output already exists
    if (exists $dict->{$self->lang}) {
      $path->[$level] = '+';
      $locale_example = $self->lang;

      if (DEBUG) {
        warn '[DICT] Locale branch at path ' .
          quote(_key($path, $level + 1)) . " and level [$level]";
      };

      # Follow the locale
      $self->_investigate(
        $dict->{$locale_example},
        $path,
        $level + 1
      );
    };

    # Define the output for the path
    $path->[$level] = '*';

    # The input example branch exists
    if ($dict->{$self->base}) {
      $locale_example = $self->base;
    }

    # A default branch exists
    elsif ($dict->{'-'} && $dict->{$dict->{'-'}}) {
      $locale_example = $dict->{'-'};
    };

    # Example path is missing - can't follow!
    unless ($locale_example) {
      warn '[DICT] No example path defined for locale branch ' .
        quote(_key($path, $level + 1)) if DEBUG;
      return;
    };

    if (DEBUG) {
      warn '[DICT] Locale branch at path ' .
        quote(_key($path, $level + 1)) . ' and level [' . $level . ']';
    };

    # Follow the locale
    $self->_investigate(
      $dict->{$locale_example},
      $path,
      $level + 1
    );
  };


  # FOLLOW ALL KEYS!
  foreach (grep { $_ ne '-' && $_ ne '_' } keys %$dict) {

    # The key is a default key
    if ($dict->{'-'} && $_ eq $dict->{'-'}) {

      # Prefix key value with default prefix
      $path->[$level] = '-' . $_;
    }

    # Set key value in path
    else {
      $path->[$level] = $_;
    };

    $self->_investigate($dict->{$_}, $path, $level + 1);
  };
};


# Return the current key
sub _key {
  return join('_', @{$_[0]}[0..$_[1] - 1])
};


# Filter all locale keys already defined
sub _filter {
  my $self = shift;

  # Iterate over all locale given keys
  foreach (grep { index($_, '+') >= 0 } keys %{$self->{keys}}) {

    # Delete all given keys
    delete $self->{keys}->{$_};

    # Delete all keys locale keys that are not already given
    $_ =~ tr/\+/\*/;
    delete $self->{keys}->{$_};
  };

  return $self;
};


# Print out all keys
sub _print {
  my $self = shift;

  my $out = $self->lang;

  my %new_keys;
  while (my ($key, $value) = each %{$self->{keys}}) {
    $key =~ s/\*/$out/g;
    $new_keys{$key} = $value;
  };

  my $template = '';

  # Iterate over all stored keys
  foreach my $key (sort { lc($a) cmp lc($b) } (keys %new_keys)) {

    $template .= '  # ' . quote($key) . ' => ';

    my $value = $new_keys{$key};

    # Print example entry
    if (!ref $value) {
      $template .= quote($value) . ",";
    }

    # Print scalar value
    elsif (ref $value eq 'SCALAR') {
      $template .= quote($$value) . ",";
    }

    # Print sub
    elsif (ref $value eq 'CODE') {
      $template .= "sub { ... },";
    };

    # Add newline
    $template .= "\n"
  };

  return $template;
};


1;

__END__