| 1 |
#!/usr/bin/perl -w
|
| 2 |
|
| 3 |
# This script copies the file named on the command line to the translation
|
| 4 |
# named in language.conf, and adds the translation-check header to it.
|
| 5 |
# It also will create the destination directory if necessary, and create the
|
| 6 |
# Makefile. It will do this by simply including the English version -- copied
|
| 7 |
# Makefiles are not supported anymore for they bear too much space for errors.
|
| 8 |
|
| 9 |
# Originally written 2000-02-26 by Peter Krefting <peterk@debian.org>
|
| 10 |
#
|
| 11 |
# Modified by Javier Fernandez-Sanguino <jfs@debian.org> to support CVS
|
| 12 |
# status of files in order to detect removed files or out-of-date CVS copies
|
| 13 |
#
|
| 14 |
# © Copyright 2000-2008 Software in the public interest, Inc.
|
| 15 |
# This program is released under the GNU General Public License, v2.
|
| 16 |
|
| 17 |
# $Id: copypage.pl,v 1.40 2011/06/04 14:09:23 taffit Exp $
|
| 18 |
|
| 19 |
use FindBin;
|
| 20 |
FindBin::again();
|
| 21 |
use lib "$FindBin::Bin/Perl";
|
| 22 |
|
| 23 |
use File::Path;
|
| 24 |
use Local::VCS qw(vcs_file_info);
|
| 25 |
use File::Temp qw/tempfile/;
|
| 26 |
use Getopt::Std;
|
| 27 |
|
| 28 |
|
| 29 |
# Declare variables only used in references to avoid warnings
|
| 30 |
use vars qw(@iso_8859_2_compat @iso_8859_3_compat @iso_8859_4_compat
|
| 31 |
@iso_8859_5_compat @iso_8859_6_compat @iso_8859_7_compat
|
| 32 |
@iso_8859_8_compat @iso_8859_9_compat @iso_8859_10_compat
|
| 33 |
@iso_8859_13_compat @iso_8859_14_compat @iso_8859_15_compat
|
| 34 |
@iso_8859_16_compat);
|
| 35 |
|
| 36 |
# Get configuration
|
| 37 |
# Read first two valid lines from language.conf
|
| 38 |
if (open CONF, "<language.conf")
|
| 39 |
{
|
| 40 |
while (<CONF>)
|
| 41 |
{
|
| 42 |
next if /^#/;
|
| 43 |
chomp;
|
| 44 |
$language = $_, next unless defined $language;
|
| 45 |
$maintainer = $_, next unless defined $maintainer;
|
| 46 |
}
|
| 47 |
close CONF;
|
| 48 |
}
|
| 49 |
else
|
| 50 |
{
|
| 51 |
warn "Unable to open language.conf. Using environment variables...\n";
|
| 52 |
}
|
| 53 |
|
| 54 |
# Values are overwritten by environment variables
|
| 55 |
if (exists $ENV{DWWW_LANG})
|
| 56 |
{
|
| 57 |
$language = $ENV{DWWW_LANG};
|
| 58 |
}
|
| 59 |
if (exists $ENV{DWWW_MAINT})
|
| 60 |
{
|
| 61 |
$maintainer = $ENV{DWWW_MAINT};
|
| 62 |
}
|
| 63 |
|
| 64 |
# Options
|
| 65 |
our ($opt_n, $opt_t, $opt_l);
|
| 66 |
getopts('nm:l:');
|
| 67 |
|
| 68 |
# Values overwritten by commandline
|
| 69 |
if (defined $opt_m)
|
| 70 |
{
|
| 71 |
$maintainer = $opt_m;
|
| 72 |
}
|
| 73 |
if (defined $opt_l)
|
| 74 |
{
|
| 75 |
$language = $opt_l;
|
| 76 |
}
|
| 77 |
|
| 78 |
# Check usage.
|
| 79 |
if ($#ARGV == -1)
|
| 80 |
{
|
| 81 |
print "Usage: $0 [-n] [-l language] [-m maintainer] page ...\n\n";
|
| 82 |
print "Copies the page from the english/ directory to the $language/ directory\n";
|
| 83 |
print "and adds the translation-check header with the current revision,\n";
|
| 84 |
print "optionally adds also the maintainer name.\n";
|
| 85 |
print "If the directory does not exist, it will be created, and the Makefile\n";
|
| 86 |
print "copied or created, depending on the setting of your language.conf file.\n\n";
|
| 87 |
print "The 'english/' part of the input path is optional.\n\n";
|
| 88 |
print "If the file already exists in the $language/ repository either\n";
|
| 89 |
print "because it was removed (and is in the Attic) or has been removed\n";
|
| 90 |
print "locally the program will abort and warn the user (unless '-n' is used)\n";
|
| 91 |
print "Environment variables:\n";
|
| 92 |
print "\tDWWW_LANG\tSets the language for the translation\n";
|
| 93 |
print "\t\t(overwrites language.conf definition\n";
|
| 94 |
print "\tDWWW_MAINT\tSets maintainer for the translation\n";
|
| 95 |
print "Options:\n";
|
| 96 |
print "\t-n\tDoes not check status of target files in CVS\n";
|
| 97 |
print "\t-m\tSets the maintainer for the translation (overwrites environment)\n";
|
| 98 |
print "\t-l\tSets the language for the translation (overwrites environment)\n";
|
| 99 |
print "\n";
|
| 100 |
|
| 101 |
}
|
| 102 |
|
| 103 |
die "Language not defined in DWWW_LANG or language.conf\n"
|
| 104 |
if not defined $language;
|
| 105 |
|
| 106 |
#warn "Maintainer name not defined in DWWW_MAINT or language.conf\n"
|
| 107 |
# if not defined $maintainer;
|
| 108 |
|
| 109 |
|
| 110 |
# Table of entities used when copying to non-latin1 encodings
|
| 111 |
@entities = (
|
| 112 |
' ', '¡', '¢', '£', '¤', '¥',
|
| 113 |
'¦', '§', '¨', '©', 'ª', '«', '¬',
|
| 114 |
'­', '®', '¯', '°', '±', '²', '³',
|
| 115 |
'´', 'µ', '¶', '·', '¸', '¹',
|
| 116 |
'º', '»', '¼', '½', '¾', '¿',
|
| 117 |
'À', 'Á', 'Â', 'Ã', 'Ä', 'Å',
|
| 118 |
'Æ', 'Ç', 'È', 'É', 'Ê', 'Ë',
|
| 119 |
'Ì', 'Í', 'Î', 'Ï', 'Ð', 'Ñ',
|
| 120 |
'Ò', 'Ó', 'Ô', 'Õ', 'Ö', '×',
|
| 121 |
'Ø', 'Ù', 'Ú', 'Û', 'Ü', 'Ý',
|
| 122 |
'Þ', 'ß', 'à', 'á', 'â', 'ã',
|
| 123 |
'ä', 'å', 'æ', 'ç', 'è', 'é',
|
| 124 |
'ê', 'ë', 'ì', 'í', 'î', 'ï',
|
| 125 |
'ð', 'ñ', 'ò', 'ó', 'ô', 'õ',
|
| 126 |
'ö', '÷', 'ø', 'ù', 'ú', 'û',
|
| 127 |
'ü', 'ý', 'þ', 'ÿ'
|
| 128 |
);
|
| 129 |
|
| 130 |
# Compatibility tables for the iso-8859 series; 1 indicates that the
|
| 131 |
# codepoint is the same as in iso-8859-1. Used to perform partial remaps
|
| 132 |
# for these.
|
| 133 |
@iso_8859_2_compat = (1,0,0,0,1,0,0,1,1,0,0,0,0,1,0,0,1,0,0,0,1,0,0,0,1,0,0,0,0,0,0,0,0,1,1,0,1,0,0,1,0,1,0,1,0,1,1,0,0,0,0,1,1,0,1,1,0,0,1,0,1,1,0,1,0,1,1,0,1,0,0,1,0,1,0,1,0,1,1,0,0,0,0,1,1,0,1,1,0,0,1,0,1,1,0,0);
|
| 134 |
@iso_8859_3_compat = (1,0,0,1,1,0,0,1,1,0,0,0,0,1,0,0,1,0,1,1,1,1,0,1,1,0,0,0,0,1,0,0,1,1,1,0,1,0,0,1,1,1,1,1,1,1,1,1,0,1,1,1,1,0,1,1,0,1,1,1,1,0,0,1,1,1,1,0,1,0,0,1,1,1,1,1,1,1,1,1,0,1,1,1,1,0,1,1,0,1,1,1,1,0,0,0);
|
| 135 |
@iso_8859_4_compat = (1,0,0,0,1,0,0,1,1,0,0,0,0,1,0,1,1,0,0,0,1,0,0,0,1,0,0,0,0,0,0,0,0,1,1,1,1,1,1,0,0,1,0,1,0,1,1,0,0,0,0,0,1,1,1,1,1,0,1,1,1,0,0,1,0,1,1,1,1,1,1,0,0,1,0,1,0,1,1,0,0,0,0,0,1,1,1,1,1,0,1,1,1,0,0,0);
|
| 136 |
@iso_8859_5_compat = (1,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
|
| 137 |
@iso_8859_6_compat = (1,0,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
|
| 138 |
@iso_8859_7_compat = (1,0,0,1,0,0,1,1,1,1,0,1,1,1,0,0,1,1,1,1,0,0,0,1,0,0,0,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
|
| 139 |
@iso_8859_8_compat = (1,0,1,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
|
| 140 |
@iso_8859_9_compat = (1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,1,1,1,1,1,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,1,1,1,1,1,0,0,1);
|
| 141 |
@iso_8859_10_compat =(1,0,0,0,0,0,0,1,0,0,0,0,0,1,0,0,1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,0,0,1,0,1,0,1,1,1,1,0,0,1,1,1,1,0,1,0,1,1,1,1,1,1,0,1,1,1,1,1,1,0,0,1,0,1,0,1,1,1,1,0,0,1,1,1,1,0,1,0,1,1,1,1,1,0);
|
| 142 |
@iso_8859_13_compat =(1,0,1,1,1,0,1,1,0,1,0,1,1,1,1,0,1,1,1,1,0,1,1,1,0,1,0,1,1,1,1,0,0,0,0,0,1,1,0,0,0,1,0,0,0,0,0,0,0,0,0,1,0,1,1,1,0,0,0,0,1,0,0,1,0,0,0,0,1,1,0,0,0,1,0,0,0,0,0,0,0,0,0,1,0,1,1,1,0,0,0,0,1,0,0,0);
|
| 143 |
@iso_8859_14_compat =(1,0,0,1,0,0,0,1,0,1,0,0,0,1,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,1,1,1,0,1,1,1,1,1,1,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,1,1,1,0,1,1,1,1,1,1,0,1);
|
| 144 |
@iso_8859_15_compat =(1,1,1,1,0,1,0,1,0,1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,0,1,1,1,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1);
|
| 145 |
@iso_8859_16_compat =(1,0,0,0,0,0,0,1,0,1,0,1,0,1,0,0,1,1,0,0,0,0,1,1,0,0,0,1,0,0,0,0,1,1,1,0,1,0,1,1,1,1,1,1,1,1,1,1,0,0,1,1,1,0,1,0,0,1,1,1,1,0,0,1,1,1,1,0,1,0,1,1,1,1,1,1,1,1,1,1,0,0,1,1,1,0,1,0,0,1,1,1,1,0,0,1);
|
| 146 |
|
| 147 |
# Check destination character encoding
|
| 148 |
my $recode = 0;
|
| 149 |
if (open WMLRC, "$language/.wmlrc")
|
| 150 |
{
|
| 151 |
while (<WMLRC>)
|
| 152 |
{
|
| 153 |
if (s/^-D CHARSET=//)
|
| 154 |
{
|
| 155 |
$recode = 1 unless /^utf-8$/i;
|
| 156 |
if ($recode && /^iso-8859-([0-9]+)$/)
|
| 157 |
{
|
| 158 |
my $compattablename = 'iso_8859_' . $1 . '_compat';
|
| 159 |
$compat = \@{$compattablename} if defined @{$compattablename};
|
| 160 |
}
|
| 161 |
last;
|
| 162 |
}
|
| 163 |
}
|
| 164 |
}
|
| 165 |
|
| 166 |
# Loop over command line
|
| 167 |
foreach $page (@ARGV)
|
| 168 |
{
|
| 169 |
# Check if valid source
|
| 170 |
if ($page =~ /wml$/ || $page =~ /src$/)
|
| 171 |
{
|
| 172 |
©($page, $recode, $compat);
|
| 173 |
}
|
| 174 |
else
|
| 175 |
{
|
| 176 |
print "$page does not seem to be a valid page.\n";
|
| 177 |
}
|
| 178 |
}
|
| 179 |
|
| 180 |
# Subroutine to copy a page
|
| 181 |
sub copy
|
| 182 |
{
|
| 183 |
my $page = shift;
|
| 184 |
my $recodelatin1 = shift;
|
| 185 |
my $compattable = shift;
|
| 186 |
print "Processing $page...\n";
|
| 187 |
|
| 188 |
# Remove english/ from path
|
| 189 |
if ($page =~ m[^english/])
|
| 190 |
{
|
| 191 |
$page =~ s[^english/][];
|
| 192 |
}
|
| 193 |
|
| 194 |
# Create needed file and directory names
|
| 195 |
my $srcfile = "english/$page"; # Source file path
|
| 196 |
$dstfile = "$language/$page"; # Destination file path
|
| 197 |
|
| 198 |
my $srcdir = $srcfile;
|
| 199 |
$srcdir =~ s[(.*/).*][$1]; # Source directory (trailing /)
|
| 200 |
my $dstdir = $dstfile;
|
| 201 |
$dstdir =~ s[(.*/).*][$1]; # Desination directory (trailing /)
|
| 202 |
|
| 203 |
my $filename = $srcfile;
|
| 204 |
$filename =~ s[$srcdir][]; # Pathless filename
|
| 205 |
|
| 206 |
my $srcmake = $srcdir . "Makefile"; # Name of source Makefile
|
| 207 |
my $dstmake = $dstdir . "Makefile"; # Name of destination Makefile
|
| 208 |
|
| 209 |
my $dsttitle = $dstfile;
|
| 210 |
$dsttitle =~ s/\.wml$/.title/; # Name of possible title translation
|
| 211 |
|
| 212 |
# Sanity checks
|
| 213 |
die "Directory $srcdir does not exist\n" unless -d $srcdir;
|
| 214 |
die "File $srcfile does not exist\n" unless -e $srcfile;
|
| 215 |
if (-e $dstfile)
|
| 216 |
{
|
| 217 |
warn "File $dstfile already exists\n";
|
| 218 |
return;
|
| 219 |
}
|
| 220 |
|
| 221 |
# Check if destination exists, if not - create it
|
| 222 |
unless (-d $dstdir)
|
| 223 |
{
|
| 224 |
print "Destination directory $dstdir does not exist,\n";
|
| 225 |
|
| 226 |
mkpath([$dstdir],0,0755)
|
| 227 |
or die "Could not create $dstdir: $!\n";
|
| 228 |
if ( -e $srcmake )
|
| 229 |
{
|
| 230 |
print "creating it and making a $dstmake\n";
|
| 231 |
open MK, "> $dstmake"
|
| 232 |
or die "Could not create $dstmake: $!\n";
|
| 233 |
print MK "include \$(subst webwml/$language,webwml/english,\$(CURDIR))/Makefile\n";
|
| 234 |
close MK;
|
| 235 |
}
|
| 236 |
}
|
| 237 |
|
| 238 |
# Check if title translation exists, if so - load it
|
| 239 |
my $pagetitle;
|
| 240 |
if (-e $dsttitle)
|
| 241 |
{
|
| 242 |
open TTL, $dsttitle
|
| 243 |
or die "Could not read $dsttitle ($!)\n";
|
| 244 |
|
| 245 |
# Scan for title;
|
| 246 |
while (<TTL>)
|
| 247 |
{
|
| 248 |
$pagetitle = $_, last
|
| 249 |
if /^<define-tag pagetitle>/;
|
| 250 |
}
|
| 251 |
|
| 252 |
close TTL;
|
| 253 |
}
|
| 254 |
else
|
| 255 |
{
|
| 256 |
undef $dsttitle;
|
| 257 |
}
|
| 258 |
|
| 259 |
# Retrieve VCS revision number
|
| 260 |
my %vcsinfo = vcs_file_info( $srcfile );
|
| 261 |
|
| 262 |
find_files_attic ( $dstfile ) if ! $opt_n;
|
| 263 |
|
| 264 |
if ( not %vcsinfo or not exists $vcsinfo{'cmt_rev'} )
|
| 265 |
{
|
| 266 |
die "Could not get revision number for `$srcfile' - bug in script?\n";
|
| 267 |
}
|
| 268 |
|
| 269 |
# Open the files
|
| 270 |
open SRC, $srcfile
|
| 271 |
or die "Could not read $srcfile ($!)\n";
|
| 272 |
|
| 273 |
open DST, ">$dstfile"
|
| 274 |
or die "Could not create $dstfile ($!)\n";
|
| 275 |
|
| 276 |
# Copy the file and insert the revision number
|
| 277 |
my $insertedrevision = 0;
|
| 278 |
|
| 279 |
while (<SRC>)
|
| 280 |
{
|
| 281 |
next if /\$Id/;
|
| 282 |
|
| 283 |
unless ($insertedrevision || /^#/)
|
| 284 |
{
|
| 285 |
printf DST qq'#use wml::debian::translation-check translation="%s"', $vcsinfo{'cmt_rev'};
|
| 286 |
print DST qq' maintainer="$maintainer"'
|
| 287 |
if defined $maintainer;
|
| 288 |
print DST qq'\n';
|
| 289 |
$insertedrevision = 1;
|
| 290 |
}
|
| 291 |
if (defined $pagetitle && /^<define-tag pagetitle>/)
|
| 292 |
{
|
| 293 |
print DST $pagetitle;
|
| 294 |
}
|
| 295 |
else
|
| 296 |
{
|
| 297 |
# Transform the string into a string that is fit for the encoding
|
| 298 |
# of the output language. We do that by first converting any
|
| 299 |
# SGML entities in the input stream into 8-bit ISO 8859-1
|
| 300 |
# encoding, and then convert extended characters (back) into
|
| 301 |
# entities if necessary for the target encoding.
|
| 302 |
|
| 303 |
# Decode
|
| 304 |
s/(&[^#;]+;)/&decodeentity($1)/ge;
|
| 305 |
s/&#(1[6-9][0-9]|2[0-4][0-9]|25[0-5]);/chr($1)/ge;
|
| 306 |
|
| 307 |
# Encode
|
| 308 |
if (defined $compattable)
|
| 309 |
{
|
| 310 |
# Output encoding is in part compatible with ISO 8859-1, only
|
| 311 |
# convert incompatible characters into entities.
|
| 312 |
s/([\xA0-\xFF])/$$compattable[ord($1)-160]?$1:$entities[ord($1)-160]/ge;
|
| 313 |
}
|
| 314 |
elsif ($recodelatin1)
|
| 315 |
{
|
| 316 |
# Output encoding is incompatible with ISO 8859-1, convert all
|
| 317 |
# 8-bit characters into entities.
|
| 318 |
s/([\xA0-\xFF])/$entities[ord($1)-160]/ge;
|
| 319 |
}
|
| 320 |
|
| 321 |
print DST $_;
|
| 322 |
}
|
| 323 |
}
|
| 324 |
|
| 325 |
unless ($insertedrevision)
|
| 326 |
{
|
| 327 |
printf DST qq'#use wml::debian::translation-check translation="%s"', $vcsinfo{'cmt_rev'};
|
| 328 |
print DST qq' maintainer="$maintainer"'
|
| 329 |
if defined $maintainer;
|
| 330 |
print DST qq'\n';
|
| 331 |
}
|
| 332 |
|
| 333 |
close SRC;
|
| 334 |
close DST;
|
| 335 |
|
| 336 |
# We're done
|
| 337 |
print "Copied $page, remember to edit $dstfile\n";
|
| 338 |
print "and to remove $dsttitle when finished\n"
|
| 339 |
if defined $dsttitle;
|
| 340 |
}
|
| 341 |
|
| 342 |
# Return the ISO-8859-1 character that corresponds to the given entity
|
| 343 |
sub decodeentity
|
| 344 |
{
|
| 345 |
my $ent = shift;
|
| 346 |
# Start at one to avoid decoding
|
| 347 |
for (my $i = 1; $i < $#entities; ++ $i)
|
| 348 |
{
|
| 349 |
return chr($i + 160) if $entities[$i] eq $ent;
|
| 350 |
}
|
| 351 |
return $ent;
|
| 352 |
}
|
| 353 |
|
| 354 |
# Find for old translations in the CVS Attic
|
| 355 |
sub find_files_attic
|
| 356 |
{
|
| 357 |
my ($file) = @_;
|
| 358 |
$file =~ s/'//;
|
| 359 |
print "Checking CVS information for $file...\n";
|
| 360 |
|
| 361 |
# Create a temporary file for the cvs results
|
| 362 |
my ($tempfh, $tmpfile) = tempfile("cvsinfo.XXXXXX", DIR => File::Spec->tmpdir, UNLINK => 0) ;
|
| 363 |
close $tempfh;
|
| 364 |
|
| 365 |
# Run 'cvs status'. Unfortunately, this is the only way
|
| 366 |
# to look for files in the Attic
|
| 367 |
system "LC_ALL=C cvs status '$file' >$tmpfile 2>&1";
|
| 368 |
|
| 369 |
if ( $? != 0 )
|
| 370 |
{
|
| 371 |
# CVS returns an error, then cleanup and return
|
| 372 |
# Do not complain because this might happen just because we
|
| 373 |
# have no network access, just cleanup the temporary file
|
| 374 |
unlink $tmpfile;
|
| 375 |
return 0;
|
| 376 |
}
|
| 377 |
|
| 378 |
# If CVS does not return an error then there is a file in CVS
|
| 379 |
# even if $dstfile is not in the filesystem
|
| 380 |
# There could be two reasons for this:
|
| 381 |
# - The user has removed it but somebody else put it in CVS
|
| 382 |
# - It resides in the Attic
|
| 383 |
my $deleted_version = "<latest_version>";
|
| 384 |
my $previous_version = "<version_before_deletion>";
|
| 385 |
my $cvs_location = "";
|
| 386 |
|
| 387 |
# Parse the result of cvs status
|
| 388 |
open(TF, $tmpfile) || die ("Cannot open temporary file: $?");
|
| 389 |
while ($line = <TF>) {
|
| 390 |
chomp $line;
|
| 391 |
if ( $line =~ /Repository revision:\s+(\d+)\.(\d+)\s+(.*)$/ ) {
|
| 392 |
$cvs_location = $3;
|
| 393 |
$deleted_version = $1.".".$2 ;
|
| 394 |
$previous_version = $1.".".($2-1);
|
| 395 |
}
|
| 396 |
}
|
| 397 |
close TF;
|
| 398 |
unlink $tmpfile; # File is not used from here on, delete it
|
| 399 |
|
| 400 |
# Now determine in which situation we are in:
|
| 401 |
|
| 402 |
if ( $cvs_location eq "" )
|
| 403 |
{
|
| 404 |
# Situation 0 - This happens when the return text is
|
| 405 |
# "Repository revision: No revision control file"
|
| 406 |
return 0; # Nothing to do here
|
| 407 |
|
| 408 |
}
|
| 409 |
|
| 410 |
if ( $cvs_location =~ /Attic\// )
|
| 411 |
{
|
| 412 |
# Situation 1 - There is a translation in the Attic
|
| 413 |
# Give information on how to restore
|
| 414 |
|
| 415 |
print STDERR "ERROR: An old translation exists in the Attic, you should restore it using:\n";
|
| 416 |
print STDERR "\tcvs update -j $deleted_version -j $previous_version $dstfile\n";
|
| 417 |
print STDERR "\t[Edit and update the file]\n";
|
| 418 |
print STDERR "\tcvs ci $dstfile\n";
|
| 419 |
die ("Old translation found\n");
|
| 420 |
}
|
| 421 |
|
| 422 |
# Situation 2 - There is already a file in CVS with this
|
| 423 |
# name, since it does not exist in the local copy maybe
|
| 424 |
# the local copy is not up to date
|
| 425 |
print STDERR "ERROR: A translation already exist in CVS for this file.\n";
|
| 426 |
print STDERR "\tPlease update your CVS copy using 'cvs update'.\n";
|
| 427 |
die ("Translation already exists\n");
|
| 428 |
|
| 429 |
}
|
Parent Directory
| 
Revision Log