SHARE
TWEET

Perl locale copier

a guest Feb 10th, 2020 86 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. #Covered by the Unlicense, author Honktown 2020
  2. use strict;
  3. use warnings;
  4.  
  5. #use File::Copy;
  6.  
  7. sub Main;
  8. sub parse_arguments;
  9. sub usage;
  10. sub deprint;
  11. sub mycopy;
  12. sub sloppy_coppy;
  13.  
  14. if ( @ARGV < 1 ){ usage(); exit 0;}
  15.  
  16. my $dh = undef;
  17. my @folders = ();
  18. my $folder = undef;
  19.  
  20. my $locale = undef;
  21. my $locfolder = undef;
  22. my @locfiles = ();
  23. my $locfile = undef;
  24. my %locfile_contents = (); #map of "dir/file" = key, to value = contents
  25.  
  26. my $herefolder = undef;
  27. my @herefolders = ();
  28. my $subfolder = "";
  29. my $overwrite = 0;
  30.  
  31. my $do_debug_prints = 0;
  32. #my $err = 0;
  33.  
  34. my %locales = (
  35.         "af"    => 1,
  36.         "ar"    => 1,
  37.         "be"    => 1,
  38.         "bg"    => 1,
  39.         "ca"    => 1,
  40.         "cs"    => 1,
  41.         "da"    => 1,
  42.         "de"    => 1,
  43.         "el"    => 1,
  44.         "en"    => 1,
  45.         "eo"    => 1,
  46.         "es-ES" => 1,
  47.         "et"    => 1,
  48.         "fi"    => 1,
  49.         "fr"    => 1,
  50.         "fy-NL" => 1,
  51.         "ga-IE" => 1,
  52.         "he"    => 1,
  53.         "hr"    => 1,
  54.         "hu"    => 1,
  55.         "id"    => 1,
  56.         "it"    => 1,
  57.         "ja"    => 1,
  58.         "ko"    => 1,
  59.         "lt"    => 1,
  60.         "lv"    => 1,
  61.         "nl"    => 1,
  62.         "no"    => 1,
  63.         "pl"    => 1,
  64.         "pt-BR" => 1,
  65.         "pt-PT" => 1,
  66.         "ro"    => 1,
  67.         "ru"    => 1,
  68.         "sk"    => 1,
  69.         "sl"    => 1,
  70.         "sq"    => 1,
  71.         "sr"    => 1,
  72.         "sv-SE" => 1,
  73.         "th"    => 1,
  74.         "tr"    => 1,
  75.         "uk"    => 1,
  76.         "vi"    => 1,
  77.         "zh-CN" => 1,
  78.         "zh-TW" => 1,
  79. );
  80.  
  81. #my %notlocales = ();
  82.  
  83. &Main;
  84.  
  85. ###################################################################
  86.  
  87.  
  88. sub Main {
  89.   my $i = 0;
  90.   my $file = undef;
  91.  
  92.   parse_arguments();
  93.  
  94. =begin comment
  95.   #opendir($dh, ".\\") || die "Couldn't open local folder";
  96.   #@folders = grep {/^[^\.]/} readdir($dh);
  97.  
  98.   print "my \@locales = (\n";
  99.  
  100.   foreach (@folders) {
  101.     print "\t\"${_}\",\n";
  102.   }
  103.  
  104.   print "\n);"
  105. =comment
  106. =cut
  107.  
  108.   opendir($herefolder, "./") or die "couldn't read this folder\n";
  109.   @herefolders = grep {/^[^\.]/} readdir($herefolder);
  110.   foreach (@herefolders) {
  111.     if ($_ eq "locale") {
  112.       print "ran from mod folder\n";
  113.       $subfolder = "locale/";
  114.     }
  115.   }
  116.   closedir($herefolder);
  117.  
  118.   foreach $folder (keys%locales) {
  119.     $locales{$folder} = "./$subfolder$folder/";
  120.   }
  121.  
  122.   opendir($locfolder, "./$subfolder$locale") or die "Could not open locale folder";
  123.   @locfiles = sort(grep {/^[^\.]/} readdir($locfolder));
  124.   closedir($locfolder);
  125.  
  126.  
  127.   foreach $folder (sort(values%locales)) {
  128.     if (-e $folder) {
  129.       #print "$folder exists already\n";
  130.     } else {
  131.       mkdir $folder or die "Unable to make folder $folder\n";
  132.     }
  133.  
  134.     foreach $locfile (@locfiles) {
  135.       $file = "./$subfolder$locale/$locfile";
  136.       print("Copying $file to $folder\n");
  137.       &mycopy($file, $folder, 1);
  138.     }
  139.     print "\n";
  140.   }
  141.  
  142.   exit 0;
  143. }
  144.  
  145. sub parse_arguments {
  146.   my @args = @ARGV;
  147.   my $arg = "";
  148.   my $i = 0;
  149.   my $temp_locale = undef;
  150.   my $to_remove = undef;
  151.  
  152.   while (scalar @ARGV) {
  153.     $arg = shift @ARGV;
  154.  
  155.     if (defined($arg)) {
  156.       deprint "$arg" . " first character: " . substr($arg, 0, 1) . " the rest: " . substr($arg, 1) . "\n";
  157.       if (index($arg, "-") != 0) { die "arguments must begin with -. bad argument: $arg\n";}
  158.       $arg = substr($arg, 1);
  159.       if ($arg eq "") {die "need more than just a hyphen for an option\n"}
  160.  
  161.       if ($arg eq "L") {
  162.         if (defined($temp_locale)) { die "-L can only be used once\n";}
  163.  
  164.         $temp_locale = shift @ARGV or die "-L needs to be followed by a locale\n";
  165.         $temp_locale =~ /^([\w]+)$/;
  166.  
  167.         if (not defined($temp_locale)) {die "locale string was not valid (letters and/or hyphens)\n"}
  168.         if (not exists($locales{$temp_locale})) {
  169.           foreach $locale (sort(keys %locales)) { deprint ("$locale\n") }
  170.           if (substr($temp_locale, 0, 1) eq "-") {
  171.             die "could not find locale: ${temp_locale} (did you forget locale after -L?)\n"
  172.           } else {
  173.             die "could not find locale: ${temp_locale}\n"
  174.           }
  175.         }
  176.  
  177.         delete($locales{$temp_locale});
  178.  
  179.       } elsif ($arg eq "NL") {
  180.         $to_remove = shift @ARGV or die "-NL needs to be followed by a locale\n";
  181.         $to_remove =~ /^([\w]+)$/;
  182.  
  183.         if (not defined($to_remove)) {die "locale to remove was not valid (letters and/or hyphens)\n"}
  184.  
  185.         if (not exists($locales{$to_remove})) {
  186.           if (substr($to_remove, 0, 1) eq "-") {
  187.             die "could not find locale to remove: ${to_remove} (did you forget locale after -L?)\n"
  188.           } else {
  189.             die "could not find locale to remove: ${to_remove}\n"
  190.           }
  191.         } else {
  192.           delete $locales{$to_remove};
  193.           print "Removed locale $to_remove\n"
  194.         }
  195.  
  196.       } elsif ($arg eq "debug") {
  197.         $do_debug_prints = 1;
  198.         print "debug prints enabled\n";
  199.  
  200.       } elsif ($arg eq "W") {
  201.         $overwrite = 1;
  202.  
  203.       } else {
  204.         die "Unrecognized argument: $arg\n"
  205.       }
  206.     }
  207.   }
  208.  
  209.   if (not defined($temp_locale)) {die "Need locale to copy\n"}
  210.   else {$locale = $temp_locale}
  211.  
  212.   print "using locale: $temp_locale\n";
  213.  
  214.   return;
  215. }
  216.  
  217. sub usage {
  218.   my $t = "\t";
  219.   print "${t}Help:\n";
  220.   $t = "\t\t";
  221.  
  222.   print "${t}copy a locale folder to every other locale (or fewer)\n";
  223.   print "${t}run in mod/ or mod/locale\n";
  224.   print "\n";
  225.   print "${t}-L <locale> to use language (only 1!)\n";
  226.   print "${t}-NL <locale> to ignore locale. can be used many times\n";
  227.   print "${t}-W to overwrite existing locale files\n";
  228.   print "\n${t}example: perl locale.pl -L pl -NL en -NL ja -W";
  229.   print "\n${t}\tcopy polish to every locale except english and japanese, overwrite existing files";
  230.   print "\n\n${t}example with prints sent to file:";
  231.   print "\n${t}\tperl locale.pl -L pl -NL en -NL ja -W > localecopy.txt 2>&1";
  232.   print "\n";
  233.   return;
  234. }
  235.  
  236. sub deprint {
  237.   my ($string) = @_;
  238.   if ($do_debug_prints) {
  239.     if (defined($string)) {
  240.       print "$string";
  241.     } else {
  242.       print "debug print missing string to print\n";
  243.     }
  244.   }
  245.  
  246.   return;
  247. }
  248.  
  249. sub mycopy {
  250.   my ($src, $dest) = @_;
  251.   my $success = 1;
  252. #  my $err_str;
  253.   my $cop = undef;
  254.  
  255.   #special parsing rules - &copy is not a call in this case
  256.   if (defined(&copy)) {
  257.     $cop = \&copy;
  258.   } else {
  259.     $cop = \&sloppy_coppy;
  260.   }
  261.  
  262.   #print("copying $file");
  263.   #if (not defined($die_on_fail)) {$die_on_fail = 0}
  264.   #$success = &$cop($src, $dest);
  265.   #if (not $success) {die "$!\n"};
  266.   &$cop($src, $dest);
  267.   return 1;
  268. }
  269.  
  270. sub sloppy_coppy {
  271.   #File::copy returns 1 on success, 0 on fail
  272.   my ($src, $dest, $die_on_fail) = @_;
  273.  
  274.   my $contents = "";
  275.   my $fh_in = undef;
  276.   #must be one or other slash! watch regex!
  277.   my $file = ( $src =~ m+[/\\]([^/\\]*)$+)[0];
  278.  
  279.   $src = $src or die "no source file to copy\n";
  280.   $dest = $dest or die "no destination\n";
  281.   $file = $file or die "could not determine file name\n";
  282.  
  283.   my $fh_out = undef;
  284.  
  285.   if ((not -e "$dest$file") or $overwrite) {
  286.     if (exists($locfile_contents{$src})) {
  287.       $contents = $locfile_contents{$src};
  288.     } else {
  289.       open($fh_in, '<:raw', $src) or die "unable to open $src\n";
  290.  
  291.       #read up to 10 megabytes - not sure how to just "read all"
  292.       read $fh_in, $contents, 10e6 or die "opened but could not read $src\n";
  293.       $locfile_contents{$src} = $contents;
  294.       close($fh_in);
  295.       deprint("$src content:\n$contents\n");
  296.     }
  297.  
  298.     open($fh_out, ">:raw", "$dest$file") or die "Could not open output file $dest$file\n";
  299.     print $fh_out $contents or die "couldn't copy contents of $src to $dest\n";
  300.     close($fh_out) or die "not sure how this is even possible, couldn't close $dest after writing\n";
  301.  
  302.   } else {
  303.     print "$dest$file exists and overwrite was not specified (-W)\n";
  304.   }
  305.  
  306.   return 1;
  307. }
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Top