From 26dd7c50e7dd99ef4d49d38fad523570734f6197 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ville=20Skytt=C3=A4?= Date: Wed, 19 Jan 2011 00:00:20 +0200 Subject: Bring back tools dir. --- tools/lib/String/Escape.pm | 625 +++++++++++++++++++++++++++++++++++++++++++++ tools/tmplgettext | 164 ++++++++++++ tools/update-po | 37 +++ 3 files changed, 826 insertions(+) create mode 100644 tools/lib/String/Escape.pm create mode 100755 tools/tmplgettext create mode 100755 tools/update-po diff --git a/tools/lib/String/Escape.pm b/tools/lib/String/Escape.pm new file mode 100644 index 0000000..2c40f45 --- /dev/null +++ b/tools/lib/String/Escape.pm @@ -0,0 +1,625 @@ +### String::Escape - Backslash escaping, word splitting, and elision functions + +### Copyright 2002 Matthew Simon Cavalletto. + # You may use this software under the same terms as Perl. + +######################################################################## + +package String::Escape; + +require 5; +use strict; +use Carp; +use Exporter; + +use vars qw( $VERSION @ISA @EXPORT_OK ); +$VERSION = 2002.001; + +push @ISA, qw( Exporter ); +push @EXPORT_OK, qw( + escape + printable unprintable + elide + quote unquote quote_non_words qprintable unqprintable + string2list string2hash list2string list2hash hash2string hash2list +); + +######################################################################## + +### Call by-name interface + +# %Escapes - escaper function references by name +use vars qw( %Escapes ); +%Escapes = ( + %Escapes, + 'none' => sub ($) { $_[0]; }, + + 'uppercase' => sub ($) { uc $_[0] }, + 'lowercase' => sub ($) { lc $_[0] }, + 'initialcase' => sub ($) { ucfirst lc $_[0] }, + + 'quote' => \"e, + 'unquote' => \&unquote, + 'quote_non_words' => \"e_non_words, + + 'printable' => \&printable, + 'unprintable' => \&unprintable, + + 'qprintable' => 'printable quote_non_words', + 'unqprintable' => 'unquote unprintable', + + 'elide' => \&elide, +); + +# String::Escape::add( $name, $subroutine ); +sub add ($$) { $Escapes{ shift(@_) } = shift(@_); } + +# @defined_names = String::Escape::names(); +sub names () { keys(%Escapes); } + +# $escaped = escape($escape_spec, $value); +# @escaped = escape($escape_spec, @values); +sub escape ($@) { + my ($escape_spec, @values) = @_; + + croak "escape called with multiple values but in scalar context" + if ($#values > 0 && ! wantarray); + + my @escapes = expand_escape_spec($escape_spec); + # warn "Escaping: ". join(' ', @escapes) . "\n"; + my ($value, $escaper); + foreach $value ( @values ) { + foreach $escaper ( @escapes ) { + $value = &$escaper( $value ); + } + } + + return wantarray ? @values : $values[0]; +} + +# @escape_functions = expand_escape_spec($escape_spec); +sub expand_escape_spec { + my $escape_spec = shift; + + if ( ref($escape_spec) eq 'CODE' ) { + return $escape_spec; + } elsif ( ref($escape_spec) eq 'ARRAY' ) { + return map { expand_escape_spec($_) } @$escape_spec; + } elsif ( ! ref($escape_spec) ) { + return map { + expand_escape_spec($_) + } map { + $Escapes{$_} or croak "unsupported escape specification '$_'; " . + "should be one of " . join(', ', names()) + } split(/\s+/, $escape_spec); + } else { + croak "unsupported escape specification '$escape_spec'"; + } +} + +######################################################################## + +### Double Quoting + +# $with_surrounding_quotes = quote( $string_value ); +sub quote ($) { '"' . $_[0] . '"' } + +# $remove_surrounding_quotes = quote( $string_value ); +sub unquote ($) { local $_ = $_[0]; s/\A\"(.*)\"\Z/$1/s; $_; } + +# $word_or_phrase_with_surrounding_quotes = quote( $string_value ); +sub quote_non_words ($) { + ( ! length $_[0] or $_[0] =~ /[^\w\_\-\/\.\:\#]/ ) ? '"'.$_[0].'"' : $_[0] +} + +### Backslash Escaping + +use vars qw( %Printable %Unprintable ); +%Printable = ( ( map { chr($_), unpack('H2', chr($_)) } (0..255) ), + "\\"=>'\\', "\r"=>'r', "\n"=>'n', "\t"=>'t', "\""=>'"' ); +%Unprintable = ( reverse %Printable ); + +# $special_characters_escaped = printable( $source_string ); +sub printable ($) { + local $_ = ( defined $_[0] ? $_[0] : '' ); + s/([\r\n\t\"\\\x00-\x1f\x7F-\xFF])/\\$Printable{$1}/sg; + return $_; +} + +# $original_string = unprintable( $special_characters_escaped ); +sub unprintable ($) { + local $_ = ( defined $_[0] ? $_[0] : '' ); + s/((?:\A|\G|[^\\]))\\([rRnNtT\"\\]|[\da-fA-F]{2})/$1.$Unprintable{lc($2)}/gse; + return $_; +} + +# quoted_and_escaped = qprintable( $source_string ); +sub qprintable ($) { quote_non_words printable $_[0] } + +# $original_string = unqprintable( quoted_and_escaped ); +sub unqprintable ($) { unprintable unquote $_[0] } + +######################################################################## + +### Elision + +use vars qw( $Elipses $DefaultLength $DefaultStrictness ); +$Elipses = '...'; +$DefaultLength = 60; +$DefaultStrictness = 10; + +# $elided_string = elide($string); +# $elided_string = elide($string, $length); +# $elided_string = elide($string, $length, $word_boundary_strictness); + # Return a single-quoted, shortened version of the string, with ellipsis +sub elide ($;$$) { + my $source = shift; + my $length = scalar(@_) ? shift() : $DefaultLength; + my $word_limit = scalar(@_) ? shift() : $DefaultStrictness; + + # If the source is already short, we don't need to do anything + return $source if (length($source) < $length); + + # Leave room for the elipses and make sure we include at least one character. + $length -= length( $Elipses ); + $length = 1 if ( $length < 1 ); + + my $excerpt; + + # Try matching $length characters or less at a word boundary. + $excerpt = ( $source =~ /^(.{0,$length})(?:\s|\Z)/ )[0] if ( $word_limit ); + + # Ignore boundaries if that fails or returns much less than we wanted. + $excerpt = substr($source, 0, $length) if ( ! defined $excerpt or + length($excerpt) < length($source) and + ! length($excerpt) || abs($length - length($excerpt)) > $word_limit); + + return $excerpt . $Elipses; +} + +######################################################################## + +# @words = string2list( $space_separated_phrases ); +sub string2list { + my $text = shift; + + carp "string2list called with a non-text argument, '$text'" if (ref $text); + + my @words; + my $word = ''; + + while ( defined $text and length $text ) { + if ($text =~ s/\A(?: ([^\"\s\\]+) | \\(.) )//mx) { + $word .= $1; + } elsif ($text =~ s/\A"((?:[^\"\\]|\\.)*)"//mx) { + $word .= $1; + } elsif ($text =~ s/\A\s+//m){ + push(@words, unprintable($word)); + $word = ''; + } elsif ($text =~ s/\A"//) { + carp "string2list found an unmatched quote at '$text'"; + return; + } else { + carp "string2list parse exception at '$text'"; + return; + } + } + push(@words, unprintable($word)); + + return @words; +} + +# $space_sparated_string = list2string( @words ); +sub list2string { + join ( ' ', map qprintable($_), @_ ); +} + +# %hash = list2hash( @words ); +sub list2hash { + my @pairs; + foreach (@_) { + my ($key, $val) = m/\A(.*?)(?:\=(.*))?\Z/s; + push @pairs, $key, $val; + } + return @pairs; +} + +# @words = hash2list( %hash ); +sub hash2list { + my @words; + while ( scalar @_ ) { + my ($key, $value) = ( shift, shift ); + push @words, qprintable($key) . '=' . qprintable($value) + } + return @words; +} + +# %hash = string2hash( $string ); +sub string2hash { + return list2hash( string2list( shift ) ); +} + +# $string = hash2string( %hash ); +sub hash2string { + join ( ' ', hash2list( @_ ) ); +} + +######################################################################## + +1; + +__END__ + +=pod + +=head1 NAME + +String::Escape - Registry of string functions, including backslash escapes + + +=head1 SYNOPSIS + + use String::Escape qw( printable unprintable ); + # Convert control, high-bit chars to \n or \xxx escapes + $output = printable($value); + # Convert escape sequences back to original chars + $value = unprintable($input); + + use String::Escape qw( elide ); + # Shorten strings to fit, if necessary + foreach (@_) { print elide( $_, 79 ) . "\n"; } + + use String::Escape qw( string2list list2string ); + # Pack and unpack simple lists by quoting each item + $list = list2string( @list ); + @list = string2list( $list ); + + use String::Escape qw( string2hash hash2string ); + # Pack and unpack simple hashes by quoting each item + $hash = hash2string( %hash ); + %hash = string2hash( $hash ); + + use String::Escape qw( escape ); + # Defer selection of escaping routines until runtime + $escape_name = $use_quotes ? 'qprintable' : 'printable'; + @escaped = escape($escape_name, @values); + + +=head1 DESCRIPTION + +This module provides a flexible calling interface to some frequently-performed string conversion functions, including applying and removing C/Unix-style backslash escapes like \n and \t, wrapping and removing double-quotes, and truncating to fit within a desired length. + +Furthermore, the escape() function provides for dynamic selection of operations by using a package hash variable to map escape specification strings to the functions which implement them. The lookup imposes a bit of a performance penalty, but allows for some useful late-binding behaviour. Compound specifications (ex. 'quoted uppercase') are expanded to a list of functions to be applied in order. Other modules may also register their functions here for later general use. (See the "CALLING BY NAME" section below for more.) + + +=head1 FUNCTION REFERENCE + +=head2 Escaping And Unescaping Functions + +Each of these functions takes a single simple scalar argument and +returns its escaped (or unescaped) equivalent. + +=over 4 + +=item quote($value) : $escaped + +Add double quote characters to each end of the string. + +=item quote_non_words($value) : $escaped + +As above, but only quotes empty, punctuated, and multiword values; simple values consisting of alphanumerics without special characters are not quoted. + +=item unquote($value) : $escaped + +If the string both begins and ends with double quote characters, they are removed, otherwise the string is returned unchanged. + +=item printable($value) : $escaped + +=item unprintable($value) : $escaped + +These functions convert return, newline, tab, backslash and unprintable +characters to their backslash-escaped equivalents and back again. + +=item qprintable($value) : $escaped + +=item unqprintable($value) : $escaped + +The qprintable function applies printable escaping and then wraps the results +with quote_non_words, while unqprintable applies unquote and then unprintable. +(Note that this is I MIME quoted-printable encoding.) + +=back + +=head2 Simple Arrays and Hashes + +=over 4 + +=item @words = string2list( $space_separated_phrases ); + +Converts a space separated string of words and quoted phrases to an array; + +=item $space_sparated_string = list2string( @words ); + +Joins an array of strings into a space separated string of words and quoted phrases; + +=item %hash = string2hash( $string ); + +Converts a space separated string of equal-sign-associated key=value pairs into a simple hash. + +=item $string = hash2string( %hash ); + +Converts a simple hash into a space separated string of equal-sign-associated key=value pairs. + +=item %hash = list2hash( @words ); + +Converts an array of equal-sign-associated key=value strings into a simple hash. + +=item @words = hash2list( %hash ); + +Converts a hash to an array of equal-sign-associated key=value strings. + +=back + +=head2 String Elision Function + +This function extracts the leading portion of a provided string and appends ellipsis if it's longer than the desired maximum excerpt length. + +=over 4 + +=item elide($string) : $elided_string + +=item elide($string, $length) : $elided_string + +=item elide($string, $length, $word_boundary_strictness) : $elided_string + +If the original string is shorter than $length, it is returned unchanged. At most $length characters are returned; if called with a single argument, $length defaults to $DefaultLength. + +Up to $word_boundary_strictness additional characters may be ommited in order to make the elided portion end on a word boundary; you can pass 0 to ignore word boundaries. If not provided, $word_boundary_strictness defaults to $DefaultStrictness. + +=item $Elipses + +The string of characters used to indicate the end of the excerpt. Initialized to '...'. + +=item $DefaultLength + +The default target excerpt length, used when the elide function is called with a single argument. Initialized to 60. + +=item $DefaultStrictness + +The default word-boundary flexibility, used when the elide function is called without the third argument. Initialized to 10. + +=back + +=head1 CALLING BY NAME + +These functions provide for the registration of string-escape specification +names and corresponding functions, and then allow the invocation of one or +several of these functions on one or several source string values. + +=over 4 + +=item escape($escapes, $value) : $escaped_value + +=item escape($escapes, @values) : @escaped_values + +Returns an altered copy of the provided values by looking up the escapes string in a registry of string-modification functions. + +If called in a scalar context, operates on the single value passed in; if +called in a list contact, operates identically on each of the provided values. + +Valid escape specifications are: + +=over 4 + +=item one of the keys defined in %Escapes + +The coresponding specification will be looked up and used. + +=item a sequence of names separated by whitespace, + +Each name will be looked up, and each of the associated functions will be applied successively, from left to right. + +=item a reference to a function + +The provided function will be called on with each value in turn. + +=item a reference to an array + +Each item in the array will be expanded as provided above. + +=back + +A fatal error will be generated if you pass an unsupported escape specification, or if the function is called with multiple values in a scalar context. + +=item String::Escape::names() : @defined_escapes + +Returns a list of defined escape specification strings. + +=item String::Escape::add( $escape_name, \&escape_function ); + +Add a new escape specification and corresponding function. + +=item %Escapes : $name, $operation, ... + +By default, the %Escapes hash is initialized to contain the following mappings: + +=over 4 + +=item quote, unquote, or quote_non_words + +=item printable, unprintable, qprintable, or unqprintable, + +=item elide + +Run the above-described functions of the same names. + +=item uppercase, lowercase, or initialcase + +Alters the case of letters in the string to upper or lower case, or for initialcase, sets the first letter to upper case and all others to lower. + +=item none + +Return an unchanged copy of the original value. + +=back + +=back + + +=head1 EXAMPLES + +Here are a few example uses of these functions, along with their output. + +=head2 Backslash Escaping + +C + + \tNow is the time\nfor all good folks\n + +C + + Now is the time + for all good folks + + + +=head2 Escape By Name + +C + + "\tNow is the time\nfor all good folks\n" + +C + + "\tNOW IS THE TIME\nFOR ALL GOOD FOLKS\n" + + +C + + \tNow is the time\n--for all good folks\n + + +=head2 String Elision Function + +C<$string = 'foo bar baz this that the other';> + +C + + foo bar baz this that the other + + +C + + foo bar... + + +C + + foo bar b... + + +=head2 Simple Arrays and Hashes + +C + + hello "I move next march" + + +C<@list = string2list('one "second item" 3 "four\nlines\nof\ntext"');> + +C + + second item + + +C 'Animal Cities', 'bar' =E 'Cheap' );> + + foo="Animal Cities" bar=Cheap + + +C<%hash = string2hash('key=value "undefined key" words="the cat in the hat"');> + +C + + the cat in the hat + +C + + 1 + + +=head1 PREREQUISITES AND INSTALLATION + +This package should run on any standard Perl 5 installation. + +To install this package, download and unpack the distribution archive from +http://www.evoscript.com/dist/ or your favorite CPAN mirror, and execute +the standard "perl Makefile.PL", "make test", "make install" sequence. + + +=head1 STATUS AND SUPPORT + +This release of String::Escape is intended for public review and feedback. +It has been tested in several environments and no major problems have been +discovered, but it should be considered "beta" pending that feedback. + + Name DSLI Description + -------------- ---- --------------------------------------------- + String:: + ::Escape bdpf Registry of useful string escaping functions + +Further information and support for this module is available at Ewww.evoscript.orgE. + +Please report bugs or other problems to Csimonm@cavalletto.orgE>. + +The following changes are in progress or under consideration: + +=over 4 + +=item * + +Use word-boundary test in elide's regular expression rather than \s|\Z. + +=item * + +Check for possible problems in the use of printable escaping functions and list2hash. For example, are the encoded strings for hashes with high-bit characters in their keys properly unquoted and unescaped? + +=item * + +Update string2list; among other things, embedded quotes (eg: a@"!a) shouldn't cause phrase breaks. + +=back + + +=head1 SEE ALSO + +Numerous modules provide collections of string manipulation functions; see L for an example. + +The string2list function is similar to to the quotewords function in the standard distribution; see L. + +Use other packages to stringify more complex data structures; see L, L, or other similar package. + + +=head1 CREDITS AND COPYRIGHT + +=head2 Developed By + + M. Simon Cavalletto, simonm@cavalletto.org + Evolution Softworks, www.evoscript.org + +=head2 Contributors + + Eleanor J. Evans piglet@piglet.org + Jeremy G. Bishop + +=head2 Copyright + +Copyright 2002 Matthew Simon Cavalletto. + +Portions copyright 1996, 1997, 1998, 2001 Evolution Online Systems, Inc. + +=head2 License + +You may use, modify, and distribute this software under the same terms as Perl. + +=cut diff --git a/tools/tmplgettext b/tools/tmplgettext new file mode 100755 index 0000000..37a2573 --- /dev/null +++ b/tools/tmplgettext @@ -0,0 +1,164 @@ +#!/usr/bin/perl + +# +# tmplgettext +# +# Creates a gettext pot-template from any text template specified by +# in (recursivly) +# +# Any text matching /<%! (.*) !%>/ (even across multiple lines) will be +# interpreted as a translatable strings like in gettext("foo") or _("foo"). +# +# e.g.: tmplgettext "^.*\.html$" ./templates >templates.pot +# +# Output goes to stdout. +# +# 04/2005 - Tobias Grimm +# 09/2006 - Andres Mair +# + +my $BASENAME; +BEGIN { + $BASENAME = $1; + unshift(@INC, $BASENAME . "../tools/lib/"); +} + +use String::Escape qw(printable); +use File::Find; +use Env qw(VERSION MY_EMAIL PACKAGE); + +my $START_TAG = ""; + +my $filePattern = ""; + +sub WritePotHeader +{ + my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = + localtime(time); + + print "# Copyright (C) $MY_EMAIL +# This file is distributed under the same license as the VDRAdmin-AM package. +# +# TRANSLATOR , YEAR +# +# +# Translators, if you are not familiar with the PO format, gettext +# documentation is worth reading, especially sections dedicated to +# this format, e.g. by running: +# info -n '(gettext)PO Files' +# info -n '(gettext)Header Entry' +# +# Some information specific to po-debconf are available at +# /usr/share/doc/po-debconf/README-trans +# or http://www.debian.org/intl/l10n/po-debconf/README-trans +# +# Developers do not need to manually edit POT or PO files. +# +#, fuzzy +msgid \"\" +msgstr \"\" +\"Project-Id-Version: $PACKAGE $VERSION\\n\" +\"Report-Msgid-Bugs-To: $MY_EMAIL\\n\"\n"; + + # FIXME: Correctly set timezone + + printf "\"POT-Creation-Date: %4d-%02d-%02d %02d:%02d+0100\"\n", + $year + 1900, $mon + 1, $mday, $hour, $min; + + print "\"PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\\n\" +\"Last-Translator: FULL NAME \\n\" +\"Language-Team: LANGUAGE \\n\" +\"MIME-Version: 1.0\\n\" +\"Content-Type: text/plain; charset=CHARSET\\n\" +\"Content-Transfer-Encoding: 8bit\\n\"\n\n"; +} + +sub my_normalize { + my $text = shift; + $text =~ s/[\t\n]//g; + $text =~ s/\\'/\'/g; + $text =~ s/\\\\/\\/g; + return printable($text); +} + +sub WritePotEntry +{ + my ($fileName, $lineNumber, $msgid) = @_; + my $escapedMsgid = my_normalize($msgid); + +# print "#: $fileName:$lineNumber\n"; + print "msgid \"$escapedMsgid\"\n"; + print "msgstr \"\"\n\n"; +} + +sub ExtractMsgids +{ + my ($fileName, @fileContent) = @_; + my $text = ""; + my $isTextStarted = 0; + my $lineCounter = 0; + my $textStartLine; + + foreach my $line (@fileContent) + { + my $lookAhead; + + $lineCounter++; + + if ($isTextStarted) + { + $text = $text . "\n"; + } + + for (my $index=0; $index < length($line); $index++) + { + $lookAhead = substr($line, $index, length($START_TAG)); + if ($lookAhead eq $START_TAG) + { + $index = $index + length($START_TAG); # skip whole tag + $isTextStarted = 1; + $textStartLine = $lineCounter; + $text = ""; + } + + if ($isTextStarted) + { + $lookAhead = substr($line, $index, length($END_TAG)); + if ($lookAhead eq $END_TAG) + { + $index = $index + length($END_TAG); # skip whole tag + if (length($text) > 0) + { + WritePotEntry($fileName, $textStartLine, $text); + } + $isTextStarted = 0; + } else { + $text = $text . substr($line, $index, 1); + } + } + } + } +} + +sub ProcessFile +{ + my $file = shift; + open(HTML, "< $file"); + my @fileContent = ; + close(HTML); + + ExtractMsgids($file, @fileContent); +} + +# +# main() +# + +$filePattern = shift(@ARGV); + +my @files = (); +find({no_chdir => 1, wanted => sub {push (@files, $_) if ($_ =~ /$filePattern/);}}, @ARGV); + +WritePotHeader; +ProcessFile $_ foreach (sort(@files)); diff --git a/tools/update-po b/tools/update-po new file mode 100755 index 0000000..8954afa --- /dev/null +++ b/tools/update-po @@ -0,0 +1,37 @@ +#!/bin/sh -e + +if [ "$1" = "--check-only" ]; then + for LANG in cs de es fi fr it nl ru; do + echo "$LANG: untranslated=$(msgattrib --untranslated po/$LANG.po | grep ^msgid | wc -l) fuzzy=$(msgattrib --fuzzy po/$LANG.po | grep ^msgid | wc -l)" + done + exit 0 +fi + +export MY_EMAIL="Andreas Mair " +export VERSION="$(grep "^my \$VERSION = " vdradmind.pl | sed -e 's#.*\"\(.*\)\".*#\1#')" +export PACKAGE="VDRAdmin-AM" + +pushd po/ +../tools/tmplgettext "^.*\.html$" ../template >tmp-html-x.pot +msguniq --no-wrap tmp-html-x.pot >tmp-pl-x.pot + +xgettext --from-code=ISO-8859-1 --no-location --no-wrap -L Perl ../vdradmind.pl --copyright-holder "$MY_EMAIL" --package-name="$PACKAGE" --package-version="$VERSION" --msgid-bugs-address="$MY_EMAIL" -j -o tmp-pl-x.pot + +# Create vdradmin.pot +# (don't know how to include our own introduction comment smarter) +sed -n '0,/^#, fuzzy$/p' vdradmin.pot +sed -e '0,/^#, fuzzy$/d' >vdradmin.pot + +rm tmp-*.pot +popd + + +for LANG in cs de es fi fr it nl ru; do + echo -n "$LANG: " + if msgmerge --no-fuzzy-matching --no-wrap po/$LANG.po po/vdradmin.pot >temp.po ; then + mv -f temp.po po/$LANG.po + echo " untranslated=$(msgattrib --untranslated po/$LANG.po | grep ^msgid | wc -l) fuzzy=$(msgattrib --fuzzy po/$LANG.po | grep ^msgid | wc -l)" + else + echo "error merging po/$LANG.po and po/vdradmin.pot" + fi +done -- cgit v1.2.3