Perl locale copier

#Covered by the Unlicense, author Honktown 2020
use strict;
use warnings;

#use File::Copy;

sub Main;
sub parse_arguments;
sub usage;
sub deprint;
sub mycopy;
sub sloppy_coppy;

if ( @ARGV < 1 ){ usage(); exit 0;}

my $dh = undef;
my @folders = ();
my $folder = undef;

my $locale = undef;
my $locfolder = undef;
my @locfiles = ();
my $locfile = undef;
my %locfile_contents = (); #map of "dir/file" = key, to value = contents

my $herefolder = undef;
my @herefolders = ();
my $subfolder = "";
my $overwrite = 0;

my $do_debug_prints = 0;
#my $err = 0;

my %locales = (
        "af"    => 1,
        "ar"    => 1,
        "be"    => 1,
        "bg"    => 1,
        "ca"    => 1,
        "cs"    => 1,
        "da"    => 1,
        "de"    => 1,
        "el"    => 1,
        "en"    => 1,
        "eo"    => 1,
        "es-ES" => 1,
        "et"    => 1,
        "fi"    => 1,
        "fr"    => 1,
        "fy-NL" => 1,
        "ga-IE" => 1,
        "he"    => 1,
        "hr"    => 1,
        "hu"    => 1,
        "id"    => 1,
        "it"    => 1,
        "ja"    => 1,
        "ko"    => 1,
        "lt"    => 1,
        "lv"    => 1,
        "nl"    => 1,
        "no"    => 1,
        "pl"    => 1,
        "pt-BR" => 1,
        "pt-PT" => 1,
        "ro"    => 1,
        "ru"    => 1,
        "sk"    => 1,
        "sl"    => 1,
        "sq"    => 1,
        "sr"    => 1,
        "sv-SE" => 1,
        "th"    => 1,
        "tr"    => 1,
        "uk"    => 1,
        "vi"    => 1,
        "zh-CN" => 1,
        "zh-TW" => 1,
);

#my %notlocales = ();

&Main;

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


sub Main {
  my $i = 0;
  my $file = undef;

  parse_arguments();

=begin comment
  #opendir($dh, ".\\") || die "Couldn't open local folder";
  #@folders = grep {/^[^\.]/} readdir($dh);

  print "my \@locales = (\n";

  foreach (@folders) {
    print "\t\"${_}\",\n";
  }

  print "\n);"
=comment
=cut

  opendir($herefolder, "./") or die "couldn't read this folder\n";
  @herefolders = grep {/^[^\.]/} readdir($herefolder);
  foreach (@herefolders) {
    if ($_ eq "locale") {
      print "ran from mod folder\n";
      $subfolder = "locale/";
    }
  }
  closedir($herefolder);

  foreach $folder (keys%locales) {
    $locales{$folder} = "./$subfolder$folder/";
  }

  opendir($locfolder, "./$subfolder$locale") or die "Could not open locale folder";
  @locfiles = sort(grep {/^[^\.]/} readdir($locfolder));
  closedir($locfolder);


  foreach $folder (sort(values%locales)) {
    if (-e $folder) {
      #print "$folder exists already\n";
    } else {
      mkdir $folder or die "Unable to make folder $folder\n";
    }

    foreach $locfile (@locfiles) {
      $file = "./$subfolder$locale/$locfile";
      print("Copying $file to $folder\n");
      &mycopy($file, $folder, 1);
    }
    print "\n";
  }

  exit 0;
}

sub parse_arguments {
  my @args = @ARGV;
  my $arg = "";
  my $i = 0;
  my $temp_locale = undef;
  my $to_remove = undef;

  while (scalar @ARGV) {
    $arg = shift @ARGV;

    if (defined($arg)) {
      deprint "$arg" . " first character: " . substr($arg, 0, 1) . " the rest: " . substr($arg, 1) . "\n";
      if (index($arg, "-") != 0) { die "arguments must begin with -. bad argument: $arg\n";}
      $arg = substr($arg, 1);
      if ($arg eq "") {die "need more than just a hyphen for an option\n"}

      if ($arg eq "L") {
        if (defined($temp_locale)) { die "-L can only be used once\n";}

        $temp_locale = shift @ARGV or die "-L needs to be followed by a locale\n";
        $temp_locale =~ /^([\w]+)$/;

        if (not defined($temp_locale)) {die "locale string was not valid (letters and/or hyphens)\n"}
        if (not exists($locales{$temp_locale})) {
          foreach $locale (sort(keys %locales)) { deprint ("$locale\n") }
          if (substr($temp_locale, 0, 1) eq "-") {
            die "could not find locale: ${temp_locale} (did you forget locale after -L?)\n"
          } else {
            die "could not find locale: ${temp_locale}\n"
          }
        }

        delete($locales{$temp_locale});

      } elsif ($arg eq "NL") {
        $to_remove = shift @ARGV or die "-NL needs to be followed by a locale\n";
        $to_remove =~ /^([\w]+)$/;

        if (not defined($to_remove)) {die "locale to remove was not valid (letters and/or hyphens)\n"}

        if (not exists($locales{$to_remove})) {
          if (substr($to_remove, 0, 1) eq "-") {
            die "could not find locale to remove: ${to_remove} (did you forget locale after -L?)\n"
          } else {
            die "could not find locale to remove: ${to_remove}\n"
          }
        } else {
          delete $locales{$to_remove};
          print "Removed locale $to_remove\n"
        }

      } elsif ($arg eq "debug") {
        $do_debug_prints = 1;
        print "debug prints enabled\n";

      } elsif ($arg eq "W") {
        $overwrite = 1;

      } else {
        die "Unrecognized argument: $arg\n"
      }
    }
  }

  if (not defined($temp_locale)) {die "Need locale to copy\n"}
  else {$locale = $temp_locale}

  print "using locale: $temp_locale\n";

  return;
}

sub usage {
  my $t = "\t";
  print "${t}Help:\n";
  $t = "\t\t";

  print "${t}copy a locale folder to every other locale (or fewer)\n";
  print "${t}run in mod/ or mod/locale\n";
  print "\n";
  print "${t}-L <locale> to use language (only 1!)\n";
  print "${t}-NL <locale> to ignore locale. can be used many times\n";
  print "${t}-W to overwrite existing locale files\n";
  print "\n${t}example: perl locale.pl -L pl -NL en -NL ja -W";
  print "\n${t}\tcopy polish to every locale except english and japanese, overwrite existing files";
  print "\n\n${t}example with prints sent to file:";
  print "\n${t}\tperl locale.pl -L pl -NL en -NL ja -W > localecopy.txt 2>&1";
  print "\n";
  return;
}

sub deprint {
  my ($string) = @_;
  if ($do_debug_prints) {
    if (defined($string)) {
      print "$string";
    } else {
      print "debug print missing string to print\n";
    }
  }

  return;
}

sub mycopy {
  my ($src, $dest) = @_;
  my $success = 1;
#  my $err_str;
  my $cop = undef;

  #special parsing rules - &copy is not a call in this case
  if (defined(&copy)) {
    $cop = \&copy;
  } else {
    $cop = \&sloppy_coppy;
  }

  #print("copying $file");
  #if (not defined($die_on_fail)) {$die_on_fail = 0}
  #$success = &$cop($src, $dest);
  #if (not $success) {die "$!\n"};
  &$cop($src, $dest);
  return 1;
}

sub sloppy_coppy {
  #File::copy returns 1 on success, 0 on fail
  my ($src, $dest, $die_on_fail) = @_;

  my $contents = "";
  my $fh_in = undef;
  #must be one or other slash! watch regex!
  my $file = ( $src =~ m+[/\\]([^/\\]*)$+)[0];

  $src = $src or die "no source file to copy\n";
  $dest = $dest or die "no destination\n";
  $file = $file or die "could not determine file name\n";

  my $fh_out = undef;

  if ((not -e "$dest$file") or $overwrite) {
    if (exists($locfile_contents{$src})) {
      $contents = $locfile_contents{$src};
    } else {
      open($fh_in, '<:raw', $src) or die "unable to open $src\n";

      #read up to 10 megabytes - not sure how to just "read all"
      read $fh_in, $contents, 10e6 or die "opened but could not read $src\n";
      $locfile_contents{$src} = $contents;
      close($fh_in);
      deprint("$src content:\n$contents\n");
    }

    open($fh_out, ">:raw", "$dest$file") or die "Could not open output file $dest$file\n";
    print $fh_out $contents or die "couldn't copy contents of $src to $dest\n";
    close($fh_out) or die "not sure how this is even possible, couldn't close $dest after writing\n";

  } else {
    print "$dest$file exists and overwrite was not specified (-W)\n";
  }

  return 1;
}