summaryrefslogtreecommitdiff
path: root/tools/lib/String/Escape.pm
diff options
context:
space:
mode:
authorAndreas Mair <amair.sob@googlemail.com>2005-10-04 14:15:11 +0200
committerAndreas Mair <amair.sob@googlemail.com>2005-10-04 14:15:11 +0200
commita935422b27fcfc8713c63033c419081b5731fcff (patch)
tree4fa4d7b68752c9c3b066a11ca7c3a58f22441954 /tools/lib/String/Escape.pm
parent32e84da8cc92fc7c69e6ecbf6d937145018f96f2 (diff)
downloadvdradmin-am-0.97-am3.4.1.tar.gz
vdradmin-am-0.97-am3.4.1.tar.bz2
2005-10-04: 0.97-am3.4.1v0.97-am3.4.1
- Fixed some bugs: -> Selected channel is remembered when editing AutoTimers (Reported by Scorp). -> Recording streaming didn't work in some cases (Reported by several people @vdr-portal.de). -> Recording commands didn't work in some cases (Reported by several people @vdr-portal.de). -> Watch TV and remote control didn't work (Reported by several people @vdr-portal.de). -> INFO button in prog_list2 didn't work. -> Getting back from timer_new to prog_summary/prog_list/prog_list2 again scrolls to line with previously selected item (Reported by Scorp). - Updated translations - Fixed some more HTMLtidy warnings.
Diffstat (limited to 'tools/lib/String/Escape.pm')
-rw-r--r--tools/lib/String/Escape.pm625
1 files changed, 625 insertions, 0 deletions
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' => \&quote,
+ 'unquote' => \&unquote,
+ 'quote_non_words' => \&quote_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<not> 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<print printable( "\tNow is the time\nfor all good folks\n" );>
+
+ \tNow is the time\nfor all good folks\n
+
+C<print unprintable( '\\tNow is the time\\nfor all good folks\\n' );>
+
+ Now is the time
+ for all good folks
+
+
+
+=head2 Escape By Name
+
+C<print escape('qprintable', "\tNow is the time\nfor all good folks\n" );>
+
+ "\tNow is the time\nfor all good folks\n"
+
+C<print escape('uppercase qprintable', "\tNow is the time\nfor all good folks\n" );>
+
+ "\tNOW IS THE TIME\nFOR ALL GOOD FOLKS\n"
+
+
+C<print join '--', escape('printable', "\tNow is the time\n", "for all good folks\n" );>
+
+ \tNow is the time\n--for all good folks\n
+
+
+=head2 String Elision Function
+
+C<$string = 'foo bar baz this that the other';>
+
+C<print elide( $string, 100 );>
+
+ foo bar baz this that the other
+
+
+C<print elide( $string, 12 );>
+
+ foo bar...
+
+
+C<print elide( $string, 12, 0 );>
+
+ foo bar b...
+
+
+=head2 Simple Arrays and Hashes
+
+C<print list2string('hello', 'I move next march');>
+
+ hello "I move next march"
+
+
+C<@list = string2list('one "second item" 3 "four\nlines\nof\ntext"');>
+
+C<print $list[1];>
+
+ second item
+
+
+C<print hash2string( 'foo' =E<gt> 'Animal Cities', 'bar' =E<gt> 'Cheap' );>
+
+ foo="Animal Cities" bar=Cheap
+
+
+C<%hash = string2hash('key=value "undefined key" words="the cat in the hat"');>
+
+C<print $hash{'words'};>
+
+ the cat in the hat
+
+C<print exists $hash{'undefined_key'} and ! defined $hash{'undefined_key'};>
+
+ 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 E<lt>www.evoscript.orgE<gt>.
+
+Please report bugs or other problems to C<E<lt>simonm@cavalletto.orgE<gt>>.
+
+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<String::Edit> for an example.
+
+The string2list function is similar to to the quotewords function in the standard distribution; see L<Text::ParseWords>.
+
+Use other packages to stringify more complex data structures; see L<Data::PropertyList>, L<Data::Dumper>, 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