[gimp-help-2/cygwin-windows-quirks] More changes to image links script

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

commit c96d72e51481bda6c0b4c5e07aee26a8816cca94
Author: Ulf-D. Ehlert <ulfehlert svn gnome org>
Date:   Fri Jun 19 12:03:04 2009 +0200

    More changes to image links script
    
    Now value for "--mode" option is a space-separated list of
    valid modes, additional mode(s) are used as fallback.

 tools/make_image_links.pl |  162 +++++++++++++++++++++++++++++----------------
 1 files changed, 106 insertions(+), 56 deletions(-)
---
diff --git a/tools/make_image_links.pl b/tools/make_image_links.pl
index 89a2c5b..923e3d1 100755
--- a/tools/make_image_links.pl
+++ b/tools/make_image_links.pl
@@ -22,34 +22,53 @@ use File::Copy;
 
 
 # Error message for command-line (usage) error:
-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";
+my $Usage = <<EOF;
+Usage: $0 [OPTIONS] srcdir [...] destdir
+OPTIONS:
+  -v|--verbose     print number of processed image files
+                   (specify more than once for debugging messages)
+  -m|--mode MODES  comma-separated list of methods to copy image files,
+                   valid modes are 'hardlink', 'symlink', and 'copy'
+EOF
 
 # Command-line options (default values)
 #
 # If "-v" option is specified, the number of links will be displayed.
 my $Verbose = 0;
-# May be specified more than once (for debugging).
+# '-v' 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";
+# Mode is a list containing "symlink", "hardlink", and/or "copy"
+my @Mode = ();
+# See "perldoc -f symlink"
+my $SYMLINK_EXISTS = eval { symlink("",""); 1 };
 
 # Read command-line options
 GetOptions(
 	"verbose|v+" => \$Verbose,
-	"mode|m=s"   => \$Mode,
+	"mode|m=s"   => sub { @Mode = split(/,/, $_[1])
+                                  or die "Error: empty mode\n"
+                            }
 ) 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?!
+if (my @tmp_mode = @Mode) {
+    @Mode = ();
+    foreach (@tmp_mode) {
+        m/^symlink|hardlink|copy$/
+            or die "Error: not a valid mode: $_\n";
+        if (m/^symlink/ && !$SYMLINK_EXISTS) {
+            warn "Warning: Symbolic links are not supported.\n";
+            next;
+        }
+        push @Mode, $_;
+    }
+    die "Error: No working mode given. Abort. \n" unless @Mode;
+} else {
+    @Mode = ("symlink", "hardlink", "copy");
+    shift @Mode unless $SYMLINK_EXISTS;
+}
 
 # Required args: one or more source directories,
 #                one destination directory.
@@ -61,90 +80,121 @@ my @Srcdirs = @ARGV;
 if ($Destdir =~ s:((x|ht)ml)/([^/]+)(/images)?/?$:$1/$3:) {
     $Language = $3;
     $Language =~ /^[a-z]{2}(_[A-Z]{2})?$/
-        or die "Invalid language: $Language\n";
+        or die "Error: invalid language: $Language\n";
 } else {
-    die "Invalid destination directory: $Destdir\n" .
+    die "Error: invalid destination directory: $Destdir\n" .
         "  (should be '(x|ht)ml/LANG[/images]')\n";
 }
 if ($Verbose > 1) {
-    print STDERR "Destination  = $Destdir\n", 
+    print STDERR "Destination  = $Destdir\n",
                  "Sources (en) = " . join(', ',  @Srcdirs) . "\n",
                  "Language     = $Language\n",
-                 "Mode         = $Mode\n";
+                 "Mode(s)      = ", join(' ', @Mode), "\n";
 }
 
 # Check for existance of directories:
 foreach (@Srcdirs, $Destdir) {
-    die "No such directory: $_\n" unless -d
+    die "Error: no such directory: $_\n" unless -d
 }
 
 # Create list of source directories:
 my @Image_dirs;
 find( sub { /^\.git/ and ($File::Find::prune = 1)
                              or
-            -d and push(@Image_dirs, $File::Find::name) 
+            -d and push(@Image_dirs, $File::Find::name)
       },
       @Srcdirs );
-die "Oops! Bug in search routine!\n" unless @Image_dirs;
+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 };
-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;
+my ($Count_all, $Count_i18n, $inc_i18n) = (0, 0, 0);
+
+# Should we look for localized images?
+my $Localize_images = ($Language ne "en") ? 1 : 0;
+
+# Simple check if we should try a fallback
+# if copying/linking image failed
+my $mode_is_known_to_work = 0;
+
+# Did last copy/link operation succeed?
+my $ok  = undef;
+
+# The appropriate method for linking/copying is
+# called via this reference to an (anonymous) subroutine
+my $exec_copy_command = undef;
+
+# Anonymous subroutines for calling the proper Perl command
+my %method = ("symlink"  => sub { my ($s, $d) = @_; symlink($s, $d); },
+              "hardlink" => sub { my ($s, $d) = @_;    link($s, $d); },
+              "copy"     => sub { my ($s, $d) = @_;
+                                  File::Copy::syscopy($s, $d); },
+             );
+# Create an anonymous subroutine for copying/linking according
+# to the specified parameter ("symlink", "hardlink", or "copy")
+sub get_copy_command {
+    my $cur_mode = shift or die "Oops!?";
+    return sub { $method{$cur_mode}->(@_) and ++$mode_is_known_to_work
+                     or warn("Error: failed to make $cur_mode for $_[0]\n");
+               }
+}
+
+# Subroutine for (re)setting coyp/link mode
+sub set_copy_mode {
+    if (defined($exec_copy_command)) {
+        # Fallback
+        my $oldmode = shift @Mode;
+        die "Error: no fallback for '$oldmode' mode. Abort.\n"
+            unless @Mode;
+        warn("Warning: '$oldmode' mode failed, " .
+             "falling back to '$Mode[0]' mode.\n");
+    }
+    $exec_copy_command = get_copy_command($Mode[0]);
+}
 
 # Main routine:
+set_copy_mode();
 foreach my $srcdir (sort @Image_dirs) {
     # Construct corresponding destination directory:
     # XXX: assuming source = images/{C,common}
-    #      and destination = xml/LANG
+    #      and destination = (x|ht)ml/LANG
     (my $dstdir = $srcdir) =~ s|(.*/)?images/[^/]+|$Destdir/images|o;
     -d $dstdir or mkpath $dstdir
-        or die "Cannot mkpath $dstdir: $!\n";
+        or die "Error: 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;
+        if $Mode[0] eq "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 ($Localize_image) {
+        if ($Localize_images) {
             (my $localized_imgfile = $imgfile) =~ s|/C/|/$Language/|o;
-            if (-e $localized_imgfile) {
-                $imgfile = $localized_imgfile;
-                ++$Count_i18n if $Verbose;
-            }
+            $inc_i18n = (-e $localized_imgfile) ? 1 : 0;
+            $imgfile = $localized_imgfile if -e _;  # if $inc_i18n;
         }
         print STDERR "$destfile\n" if $Verbose > 2;
-        if ($Make_symlink) {
-            # If necessary, change relative path too:
+        # Special case symlinks:
+        if ($Mode[0] eq "symlink") {
             $dst_to_src_path = $save_path;
+            # If necessary, change relative path too:
             $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");
+                if ($Localize_images && $imgfile =~ m|/$Language/|o);
+            # Use a relative symlink to image file:
+            $imgfile = catfile($dst_to_src_path, $basename);
         }
-        ++$Count_all if $Verbose;
-    }
-}
+        $ok = $exec_copy_command->($imgfile, $destfile);
+        if (!$ok) {
+            die "Abort.\n" if ($mode_is_known_to_work); # XXX: what else?
+            set_copy_mode();
+            redo;
+        }
+        ++$Count_all  if $Verbose;
+        ++$Count_i18n if $Verbose and $inc_i18n;
+    } # foreach imgfile
+} # foreach srcdir
 
 # print number or created links/copies:
-print " ", $Count_all, ($Localize_image ? " ($Language: $Count_i18n)" : ""), "\n"
+print " ", $Count_all, ($Localize_images ? " ($Language: $Count_i18n)" : ""), "\n"
     if $Verbose;