/usr/share/doc/libunicode-map-perl/examples/mirrorMappings is in libunicode-map-perl 0.112-11+b1.
This file is owned by root:root, with mode 0o755.
The actual contents of the file can be viewed below.
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 | #!/usr/bin/perl -w
use strict;
use Getopt::Long;
use HTTP::Status;
use LWP::Simple;
use Unicode::Map;
my $emptyMap = 0;
my $numWarnings = 0;
my $numErrors = 0;
my %opt = ( );
main: {
$|=1;
_getOptions ( );
_mirror ( );
_summarizeResult ( );
exit $numErrors;
}
sub _getOptions {
GetOptions ( \%opt, "update" );
if ( !$opt{"update"} ) {
usage ( );
}
}
sub usage {
print <<EOF;
Usage: mirrorMappings --update [\@ids]
An utility for hardcore Unicode::Map perl developers.
It mirrors a collection of textual Unicode mapping files in order to create
binary mapping files. Mirrors the charsets for the ids specified. If none
specified the whole set mentioned in control file REGISTRY will be updated.
Can cause quite some net traffic!
EOF
exit 1;
}
sub _mirror ( ) {
$emptyMap = new Unicode::Map ( );
if ( @ARGV ) {
for ( @ARGV ) {
_mirrorOne ( $_ );
}
} else {
for ( sort $emptyMap->ids() ) {
_mirrorOne ( $_ );
}
}
}
sub _mirrorOne {
my ($id) = @_;
print "Processing \"$id\": ";
$id = $emptyMap -> id ( $_ );
my $srcURL = $emptyMap -> srcURL ( $id );
my $srcCopy = $emptyMap -> src ( $id );
if ( !$srcCopy ) {
print "Error!\n";
print "! No 'src:' entry for this charset in file 'REGISTRY'!\n";
$numErrors++;
return;
}
if ( !_mkFilePath($srcCopy) ) {
print "Error!\n";
print "Couldn't create directory! ($!)\n";
$numErrors++;
return;
}
if ( !$srcURL ) {
print "Warning!\n";
print <<EOF;
? No source URL for charset "$id"!
This indicates an error unless you added an charset source manually to
the control file "REGISTRY" and don't want to update it automatically!
EOF
$numWarnings++;
return;
}
my $existed = -e $srcCopy;
$^W = 0; # no warnings here
my $rc;
for ( 1..2 ) {
$rc = mirror ( $srcURL, $srcCopy );
# If a BAD_REQUEST occurs for stupid reasons try another time.
last unless $rc == RC_BAD_REQUEST;
}
$^W = 1;
if ( is_error($rc) ) {
my $msg = status_message ( $rc );
print "Error!\n";
print "! Couldn't mirror \"$srcURL\"! ($rc: $msg)\n";
$numErrors++;
return;
}
if ( !$existed ) {
print "created \"$srcCopy\"\n";
} else {
if ( $rc==RC_NOT_MODIFIED ) {
print "is uptodate.\n";
} else {
print "updated.\n";
}
}
}
sub _summarizeResult {
if ( $numWarnings==0 && $numErrors==0 ) {
print "Ok. Everything went fine!\n";
} elsif ( $numErrors>0 ) {
my $msg;
$msg = "$numErrors error";
$msg .= "s" if $numErrors>1;
$msg .= ", $numWarnings warning" if $numWarnings>0;
$msg .= "s" if $numWarnings>1;
$msg .= ".";
print "Error! Encountered $msg\n";
} else {
my $msg;
$msg = "$numWarnings warning";
$msg .= "s" if $numWarnings>1;
$msg .= ".";
print "Warning! Possible trouble! $msg\n";
}
}
##
## Utilities
##
sub _mkFilePath {
my ( $filePath ) = @_;
my $file = substr ( $filePath, rindex($filePath,"/")+1 );
my $path = $filePath; $path =~ s/$file$//;
_mkPath ( $path );
}
sub _mkPath {
my ( $path ) = @_;
my $current = "";
for (grep {$_} split /\//, $path) {
$current .= "/$_";
if ( !-d $current ) {
if ( !_mkdir($current) ) {
return 0;
}
}
}
1}
sub _mkdir {
my ( $path ) = @_;
if ( !-d $path ) {
if ( !mkdir ($path, 0777 ) ) {
return 0;
}
}
1}
|