[gimp-help-2/cygwin-windows-quirks] Enhance Perl script for making links to images

[Ulf-D. Ehlert <ulfehlert src gnome org>]

commit 2a3f8af8176643b07d47fd67173c9c3b9fe60e9a
Author: Ulf-D. Ehlert <ulfehlert svn gnome org>
Date:   Mon Jun 15 12:41:49 2009 +0200

    Enhance Perl script for making links to images
    
    Add modes for either making symlinks, hardlinks, or copying files.
    The mode can be specified as command line option, in order to
    handle some weird problems with symlinks on Cygwin/Windows.
    TODO: use more than one mode, with additional mode(s) as fallback?!

 tools/make_image_links.pl |  120 ++++++++++++++++++++++++++++++++------------
 1 files changed, 87 insertions(+), 33 deletions(-)
---
diff --git a/tools/make_image_links.pl b/tools/make_image_links.pl
index eb8eacb..89a2c5b 100755
--- a/tools/make_image_links.pl
+++ b/tools/make_image_links.pl
@@ -14,36 +14,70 @@
 
 use warnings;
 use strict;
+use Getopt::Long;
 use File::Find;
 use File::Path qw/mkpath/;
 use File::Spec::Functions qw/abs2rel splitpath catfile/;
+use File::Copy;
 
 
 # Error message for command-line (usage) error:
-my $Usage = "Usage: $0 [-v] srcdir [...] destdir";
+my $Usage = "Usage: $0 [OPTIONS] srcdir [...] destdir\n" .
+            "OPTIONS:\n" .
+            "  -v | --verbose     print number of image files\n" .
+            "                     (specify more than once for debugging)\n" .
+            "  -m | --mode MODE   specify copy mode:\n" .
+            "                     ('hardlink', 'symlink', or 'copy')\n";
+
+# Command-line options (default values)
+#
 # If "-v" option is specified, the number of links will be displayed.
 my $Verbose = 0;
-if (@ARGV && $ARGV[0] =~ /-v|--verbose/) {
-    $Verbose = 1;
-    shift;
-}
+# May be specified more than once (for debugging).
+Getopt::Long::Configure("bundling");
+# For now, language will be derived from destination directory
+my $Language = undef;
+# Mode may be "symlink", "hardlink", or "copy"
+my $Mode = "symlink";
+
+# Read command-line options
+GetOptions(
+	"verbose|v+" => \$Verbose,
+	"mode|m=s"   => \$Mode,
+) or die "$Usage\n";
+
+# Check mode:
+$Mode =~ /^symlink|hardlink|copy$/
+    or die "Not a valid mode: $Mode\n";
+# TODO: Use a list of modes with additional mode(s) as fallback?!
+
 # Required args: one or more source directories,
 #                one destination directory.
 die "$Usage\n" if scalar @ARGV < 2;
 my $Destdir = pop;
-$Destdir =~ s|(/images)?/?$||;
 my @Srcdirs = @ARGV;
 
+# XXX: assuming destination = '(x|ht)ml/LANG[/images]
+if ($Destdir =~ s:((x|ht)ml)/([^/]+)(/images)?/?$:$1/$3:) {
+    $Language = $3;
+    $Language =~ /^[a-z]{2}(_[A-Z]{2})?$/
+        or die "Invalid language: $Language\n";
+} else {
+    die "Invalid destination directory: $Destdir\n" .
+        "  (should be '(x|ht)ml/LANG[/images]')\n";
+}
+if ($Verbose > 1) {
+    print STDERR "Destination  = $Destdir\n", 
+                 "Sources (en) = " . join(', ',  @Srcdirs) . "\n",
+                 "Language     = $Language\n",
+                 "Mode         = $Mode\n";
+}
+
 # Check for existance of directories:
 foreach (@Srcdirs, $Destdir) {
     die "No such directory: $_\n" unless -d
 }
 
-# XXX: assuming destination = xml/LANG[/images]
-(my $Language = $Destdir) =~ s|.*/([^/]+)/?$|$1|;
-my $Translatable = (($Language =~ /^[a-z]{2}(_[A-Z]{2})?$/) &&
-                    ($Language ne "en"));
-
 # Create list of source directories:
 my @Image_dirs;
 find( sub { /^\.git/ and ($File::Find::prune = 1)
@@ -53,10 +87,15 @@ find( sub { /^\.git/ and ($File::Find::prune = 1)
       @Srcdirs );
 die "Oops! Bug in search routine!\n" unless @Image_dirs;
 
+# At verbose mode, the number of links will be displayed:
+my ($Count_all, $Count_i18n) = (0, 0);
 # See "perldoc -f symlink"
 my $Symlink_exists = eval { symlink("",""); 1 };
-# If verbose mode, the number of links will be displayed:
-my ($Count_all, $Count_i18n) = (0, 0);
+my $Hardlink_works = undef;
+my $Make_symlink   = ($Mode eq "symlink")  ? 1 : 0;
+my $Make_hardlink  = ($Mode eq "hardlink") ? 1 : 0;
+my $Make_copy      = ($Mode eq "copy")     ? 1 : 0;
+my $Localize_image = ($Language ne "en")   ? 1 : 0;
 
 # Main routine:
 foreach my $srcdir (sort @Image_dirs) {
@@ -64,33 +103,48 @@ foreach my $srcdir (sort @Image_dirs) {
     # XXX: assuming source = images/{C,common}
     #      and destination = xml/LANG
     (my $dstdir = $srcdir) =~ s|(.*/)?images/[^/]+|$Destdir/images|o;
-    mkpath $dstdir unless -d $dstdir;
-    # Get relative symlink pointing to image source directory
-    my $save_path = my $dst_to_src_path = abs2rel($srcdir, $dstdir);
+    -d $dstdir or mkpath $dstdir
+        or die "Cannot mkpath $dstdir: $!\n";
+    # Get relative path from $dstdir to (image source directory) $srcdir;
+    # this path is needed if/when making relative symlinks.
+    my $save_path = my $dst_to_src_path = abs2rel($srcdir, $dstdir)
+        if $Make_symlink;
     foreach my $imgfile (glob "$srcdir/*.*") {
         next unless -f $imgfile;
+        my $basename = (splitpath($imgfile))[2];  # (vol, dir, file)
+        my $destfile = catfile($dstdir, $basename);  # the new file/link
         # Check for existance of localized image:
-        if ($Translatable) {
-            $dst_to_src_path = $save_path;
+        if ($Localize_image) {
             (my $localized_imgfile = $imgfile) =~ s|/C/|/$Language/|o;
-            $dst_to_src_path =~ s|/C/|/$Language/|o if -e $localized_imgfile;
-            ++$Count_i18n if $Verbose && -e _;
+            if (-e $localized_imgfile) {
+                $imgfile = $localized_imgfile;
+                ++$Count_i18n if $Verbose;
+            }
+        }
+        print STDERR "$destfile\n" if $Verbose > 2;
+        if ($Make_symlink) {
+            # If necessary, change relative path too:
+            $dst_to_src_path = $save_path;
+            $dst_to_src_path =~ s|/C/|/$Language/|o
+                if ($Localize_image && $imgfile =~ m|/$Language/|o);
+            # Create relative symlink to image file:
+            symlink(catfile($dst_to_src_path, $basename), $destfile)
+                or die("Cannot symlink $destfile to $imgfile\n");
+        } elsif ($Make_hardlink) {
+            # Create hardlink to image file:
+            link($imgfile, $destfile)
+                or die("Error: Cannot link $imgfile to $destfile\n");
+        } elsif ($Make_copy) {
+            # Copy file - slow, but should always work ...
+            File::Copy::syscopy($imgfile, $destfile)
+                or die("Error: Cannot copy $imgfile to $destfile: $!\n");
+        } else {
+            die("Oops!? No working mode for linking/copying $imgfile!\n");
         }
-        my $basename = (splitpath($imgfile))[2];  # (vol, dir, file)
-        # Create relative symlink to image file:
-        symlink(catfile($dst_to_src_path, $basename),
-                catfile($dstdir, $basename));
-        # XXX: this can be expanded to (an optimized version of)
-        #      "try hardlink, then symlink, then copy":
-        #          link(source, destination)
-        #                      or
-        #          $Symlink_exists and symlink(source, destination)
-        #                      or
-        #          copy(source, destination);
         ++$Count_all if $Verbose;
     }
 }
 
-# print number or created symlinks:
-print " ", $Count_all, ($Translatable ? " ($Language: $Count_i18n)" : ""), "\n"
+# print number or created links/copies:
+print " ", $Count_all, ($Localize_image ? " ($Language: $Count_i18n)" : ""), "\n"
     if $Verbose;