1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
|
#!/usr/bin/env perl
#
# make_image_links.pl
#
# This script creates relative symlinks in xml/LANG to images files
# in images/C and images/common.
#
# Do not use this script directly, it's meant to be run by 'make'.
#
# Usage:
# cd <top_srcdir> # where src/ and tools/ are
# tools/make_image_links.pl [-v] images/C images/common xml/LANG
#
use warnings;
use strict;
use Getopt::Long;
use File::Find;
use File::Path qw/mkpath/;
use File::Spec::Functions qw/abs2rel rel2abs splitpath catfile/;
use File::Copy;
# Error message for command-line (usage) error:
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;
# '-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 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" => sub { @Mode = split(/,/, $_[1])
or die "Error: empty mode\n"
}
) or die "$Usage\n";
# Check mode:
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.
die "$Usage\n" if scalar @ARGV < 2;
my $Destdir = pop;
my @Srcdirs = @ARGV;
# assuming destination = (x|ht)ml/LANG[/images]
my $locale_re = qr/[a-z]{2}(?:_[A-Z]{2})?/;
if ($Destdir =~ s!((?:x|ht)ml)/($locale_re)(?:/images/?)?$!$1/$2!) {
$Language = $2;
} else {
die "Error: 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(s) = ", join(' ', @Mode), "\n";
}
# Check for existence of directories:
foreach (@Srcdirs, $Destdir) {
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)
},
@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, $inc_i18n) = (0, 0, 0);
# Should we look for localized images?
my $Localize_images = ($Language ne "en") ? 1 : 0;
# 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!?";
# Simple check if we should try a fallback or abort
# if copying/linking image failed
my $mode_is_known_to_work = 0;
return sub {
my $ok = $method{$cur_mode}->(@_);
if ($ok) {
++$mode_is_known_to_work;
} else {
warn("Error: failed to make $cur_mode for $_[0]\n");
die("Abort.\n") if ($mode_is_known_to_work); # XXX: what else?
}
return $ok;
}
}
# Subroutine for (re)setting copy/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,
# assuming source = [.../]images/{C,common}
# destination = (x|ht)ml/LANG
(my $dstdir = $srcdir) =~ s|(.*/)?images/[^/]+|$Destdir/images|o;
-d $dstdir or mkpath $dstdir
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.
# FIXME: change this code, File::Spec::Unix is buggy(?!) --
# abs2rel($srcdir, $dstdir) doesn't work if $srcdir starts with "../"
my $dst_to_src_symlink_path =
abs2rel(rel2abs($srcdir), $dstdir) 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 existence of localized image:
if ($Localize_images) {
(my $localized_imgfile = $imgfile) =~ s|/C/|/$Language/|o;
$inc_i18n = (-e $localized_imgfile) ? 1 : 0;
$imgfile = $localized_imgfile if -e _; # if $inc_i18n;
}
print STDERR "$destfile\n" if $Verbose > 2;
# Special case symlinks:
if ($Mode[0] eq "symlink") {
my $dst_to_src_path = $dst_to_src_symlink_path;
# If necessary, change relative path too:
$dst_to_src_path =~ s|/C/|/$Language/|o
if ($Localize_images && $imgfile =~ m|/$Language/|o);
# Use a relative symlink to image file:
$imgfile = catfile($dst_to_src_path, $basename);
}
my $ok = $exec_copy_command->($imgfile, $destfile);
if (!$ok) {
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_images ? " ($Language: $Count_i18n)" : ""), "\n"
if $Verbose;
|
