#!/usr/bin/perl
# -*-cperl-*-

=head1 VENUE

Data::Rlist - A lightweight data language for Perl, C and C++

=cut

# $Writestamp: 2008-07-17 17:38:13 eh2sper$
# $Compile: perl -c Rlist.pm; pod2html --title="Random-Lists" Rlist.pm >../../Rlist.pm.html$
# $Comp1le: podchecker Rlist.pm$

=pod

F<Random-Lists> (Rlist) is  a tag/value text format, able to represent  arbitary data structures in
plain text.   Like in awk,  Perl and  Python, basic types  are lists (sequential,  associative) and
scalars (string, number).

You can write any Perl data structure into files as legible text.  You can reload the text in Perl,
or  in C++  or Python  programs.  In  C++, for  example, you  then get  same structure  in  form of
F<double>s (without loosing precision) and STL types.

You can also generate CSV and XML from arbitary Perl types.

Like with CSV  the lexical overhead is minimal:  files are merely data.  In text  editors users see
the pure data in a structured from.  In short, the format

- allows the definition of hierachical, constant data,

- no user-defined types, no keywords, no variables and no arithmetic expressions,

- 7-bit-ASCII character encoding.

The implemenations are  also extremely fast and very  well tested.  They also scale  well: a single
text files can  express hundreds of megabytes of  data and is still processed in  constant time and
with constant memory requirements.

Since Rlist allows  no user-defined types the data  is structured out of simple  scalars and lists.
So the structures  are tacit consents between the  users of the data.  It is  conceivable to simply
store meta information along with the data.

=head2 Scalars Values

Quoted strings:

    "Hello, World!"

    <<hamlet
    "This above all: to thine own self be true". - (Act I, Scene III).
    hamlet

Symbols (Unquoted Strings):

    foobar   cogito.ergo.sum   Memento::mori

Numbers:

    38   10e-6   -.7   3.141592653589793

Identifiers  (aka symbols)  are strings  consisting only  of F<[a-zA-Z_0-9-/~:.@]>  characters; for
symbols quotes are optional.  All other strings must be wrapped in double-quotes (single-quotes are
not allowed).

Numbers adhere  to the IEEE 754  syntax for integer-  and floating-point numbers.  For  details see
F<L</is_symbol>()> and F<L</is_number>()>.

=head2 List Values

Arrays:

    ( 1, 2, ( 3, "Audiatur et altera pars!" ) )

Maps:

    {
        key = value;
        lonely-key;
        3.14159 = Pi;
        "Meta-syntactic names" = (foo, bar, "lorem ipsum", Acme, ___);
    }

Note this  is not Perl syntax.

=head1 SYNOPSIS

    use Data::Rlist;

=head2 File and String I/O

File I/O of any Perl data F<$thing>:

                  Data::Rlist::write($thing, $filename);
    $thing      = Data::Rlist::read($filename);
    $thing      = ReadData($filename); # exported function

F<$thing> can be stringified:

    $string_ref = Data::Rlist::write_string($thing);
    $string     = Data::Rlist::make_string($thing);
    $thing      = Data::Rlist::read_string($string);
    $thing      = ReadData(\$string);

=cut

#=head2 Writing and Parsing XML

=pod

=head2 Object-oriented Interface

    $object     = new Data::Rlist(-data => $thing, -output => \$target_string)

    $string_ref = $object->write; # compile $thing, return \$target_string

    use Env qw/HOME/;

    $object->set(-output => "$HOME/.foorc");

    $object->write;             # write "~/.foorc", return 1
    $object->write(".barrc");   # the argument overrides -output
    WriteData($object);         # dto.

For objects the F<-input> attribute defines the text to be compiled into Perl data:

    $object->set(-input => \$input_string);

    $thing      = $object->read;
    $thing      = $object->read($other_string);  # overrides -input

    $object->set(-input => "$HOME/.foorc");

    $foorc      = $object->read;                 # parse "~/.foorc"
    $barrc      = $object->read("$HOME/.barrc"); # override -input

    $thing      = $object->read(\$string);       # dto., but parse $string
    $thing      = $object->read_string($string_or_ref);
    $thing      = ReadData($string_or_ref);

To compile a string out of thin air (ignoring the F<-output> attribute), use:

    $string_ref = $object->write_string;
    $string     = $object->make_string;  # dto. but return string value, not ref

    print $object->make_string; # dumps $thing to STDOUT
    PrintData($object);         # dto.
    PrintData($thing);          # dto.

=head2 Deep Data Copies

To create deep-copies of Perl data:

    $reloaded   = Data::Rlist::keelhaul($thing);

    $object     = new Data::Rlist(-data => $thing);

    $reloaded   = $object->keelhaul;
    $reloaded   = KeelhaulData($object);

The metaphor F<keelhaul>  vividly connotes that F<$thing> is stringified,  then compiled back.  For
more information see F<L</keelhaul>()>, and its variant is F<L</deep_compare>()>:

    print join("\n", Data::Rlist::deep_compare($a, $b));

=head2 More Examples

String- and number values:

    "Hello, World!"
    foo                         # compiles to { 'foo' => undef }
    3.1415                      # compiles to { 3.1415 => undef }

Array values:

    (1, a, 4, "b u z")          # list of numbers/strings

    ((1, 2),
     (3, 4))                    # list of list (4x4 matrix)

    ((1, a, 3, "foo bar"),
     (7, c, 0, ""))             # another list of lists

Here-document strings:

		$hello = ReadData(\<<HELLO)
		( <<DEUTSCH, <<ENGLISH, <<FRANCAIS, <<CASTELLANO, <<KLINGON, <<BRAINF_CK )
	Hallo Welt!
	DEUTSCH
	Hello World!
	ENGLISH
	Bonjour le monde!
	FRANCAIS
	Ola mundo!
	CASTELLANO
	~ nuqneH { ~ 'u' ~ nuqneH disp disp } name
	nuqneH
	KLINGON
	++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++
	..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.
	BRAINF_CK
	HELLO

Compiles F<$hello> as 

	[ "Hallo Welt!\n", "Hello World!\n", "Bonjour le monde!\n", "Ola mundo!\n",
      "~ nuqneH { ~ 'u' ~ nuqneH disp disp } name\n",
	  "++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++\n..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.\n" ]

Configuration object as hash:

    {
        contribution_quantile = 0.99;
        default_only_mode = Y;
        number_of_runs = 10000;
        number_of_threads = 10;
        # etc.
    }

Altogether:

    Metaphysic-terms =
    {
        Numbers =
        {
            3.141592653589793 = "The ratio of a circle's circumference to its diameter.";
            2.718281828459045 = <<___;
The mathematical constant "e" is the unique real number such that the value of
the derivative (slope of the tangent line) of f(x) = e^x at the point x = 0 is
exactly 1.
___
            42 = "The Answer to Life, the Universe, and Everything.";
        };

        Words =
        {
            ACME = <<Value;
A fancy-free Company [that] Makes Everything: Wile E. Coyote's supplier of equipment and gadgets.
Value
            <<Key = <<Value;
foo bar foobar
Key
[JARGON] A widely used meta-syntactic variable; see foo for etymology.  Probably
originally propagated through DECsystem manuals [...] in 1960s and early 1970s;
confirmed sightings go back to 1972. [...]
Value
        };
    };

=head1 LANGUAGE DETAILS

=head2 Character Encoding

Rlist text is implemented with 7-bit-ASCII.  The  95 printable character codes 32 to 126 occupy one
character.  Codes 0  to 31 and 127 to  255 require four characters each: the  F<\> escape character
followed by  the octal code number.  For example, the  German Umlaut character F<E<uuml>>  (252) is
translated into F<\374>.  An exception are the following codes:

    ASCII               ESCAPED AS
    -----               ----------
      9 tab               \t
     10 linefeed          \n
     13 return            \r
     34 quote     "       \"
     39 quote     '       \'
     92 backslash \       \\

=head2 Values, Scalar Values, Default Values

Rlist F<values> are either scalars, array elements or the value of a pair. Each value is constant.

Number  and  string constants  follow  the  C language  lexicography.   Strings  that  look like  C
identifier names  must not  be quoted.   When read back  all strings  are unquoted.   Quoting means
F<L<to encode|/escape>()> characters according to the input character set, then to double-quote the
result.

By definition the default scalar value is the  empty string C<"">.  So in Perl F<undef> is compiled
into C<"">.

=head3 Here-Documents

Rlist is capable of a line-oriented form of quoting based on the UNIX shell F<here-document> syntax
and RFC 111.  Multi-line quoted strings can be expressed with

    <<DELIMITER

Following the sigil F< << > an identifier  specifies how to terminate the string scalar.  The value
of the  scalar will be  all lines  following the current  line down to  the line starting  with the
delimiter.  There must be no space between the F< << > and the identifier.  For example,

    {
        var = {
            log = {
                messages = <<LOG;
    Nov 27 21:55:04 localhost kernel: TSC appears to be running slowly. Marking it as unstable
    Nov 27 22:34:27 localhost kernel: Uniform CD-ROM driver Revision: 3.20
    Nov 27 22:34:27 localhost kernel: Loading iSCSI transport class v2.0-724.<6>PNP: No PS/2 controller found. Probing ports directly.
    Nov 27 22:34:27 localhost kernel: wifi0: Atheros 5212: mem=0x26000000, irq=11
    LOG
            };
        };
    }

See also L</Embedded Perl Code>.

=head3 Binary Data

Binary  data  can be  represented  as  base64-encoded  string, or  L<here-document|/Here-Documents>
string.  For example,

    use MIME::Base64;

    $str = encode_base64($binary_buf);

The returned encoded string F<$str> is broken into  lines of no more than 76 characters each and it
will  end with  C<"\n"> unless  it  is empty.   Since F<$str>  ends  with C<"\n">  it qualifies  as
here-document. For example,

    use Data::Rlist;
    use MIME::Base64;

    $binary_data = join('', map { chr(int rand 256) } 1..300);
    $sample = { random_string => encode_base64($binary_data) };

    WriteData $sample, 'random.rls', 'default';

This code will write a file F<random.rls> that looks like:

    {
        random_string = <<___
    w5BFJIB3UxX/NVQkpKkCxEulDJ0ZR3ku1dBw9iPu2UVNIr71Y0qsL4WxvR/rN8VgswNDygI0xelb
    aK3FytOrFg6c1EgaOtEudmUdCfGamjsRNHE2s5RiY0ZiaC5E5XCm9H087dAjUHPtOiZEpZVt3wAc
    KfoV97kETH3BU8/bFGOqscCIVLUwD9NIIBWtAw6m4evm42kNhDdQKA3dNXvhbI260pUzwXiLYg8q
    MDO8rSdcpL4Lm+tYikKrgCih9UxpWbfus+yHWIoKo/6tW4KFoufGFf3zcgnurYSSG2KRLKkmyEa+
    s19vvUNmjOH0j1Ph0ZTi2pFucIhok4krJi0B5yNbQStQaq23v7sTqNom/xdRgAITROUIoel5sQIn
    CqxenNM/M4uiUBV9OhyP
    ___
    ;
    }

Each line except  the last in the here-doc-string  has 75 characters, plus the newline.   It is not
necessary, however, to write the string as here-doc.  See also L<Encode>, L<MIME::Base64>.

=head3 Embedded Perl Code

Rlists    may     define    embedded    programs:    F<nanonscripts>.      They're    defined    as
L<here-document|/Here-Documents>  that is  delimited  with the  special  delimiter C<"perl">.   For
example,

    hello = <<perl;
    print "Hello, World!";
    perl

Another example is

    ( <<perl, <<perl, <<perl, <<perl )
    print "Hello World!\n"			# english
    perl
    print "Hallo Welt!\n"			# german
    perl
    print "Bonjour le monde!\n"		# french
    perl
    print "Olá mundo!\n"			# spanish
    perl

After the  text has been  fully parsed you  call F<evaluate_nanoscripts()> to F<eval>  the embedded
codes in the order of their occurrence.  Then F<evaluate_nanoscripts()> arranges, that...

=over

=item *

within the F<eval> the F<$Rlist> variable defines the current Rlist (the root of the whole input),
which is either an unblessed array-ref or hash-ref;

=item *

within the F<eval> the list that hosts the nanoscript is associative (some hash), the variable
F<$this> refers to this hash, and F<$where> names the key whose value defines the script;

=item *

otherwise F<$this> refers to the array that hosts the nanoscript, and F<$where> is defined as the
(integer) index of the element that defines the script.

=item *

each code is F<eval>d and the result is F<put in place of the nanoscript>, so that the already
compiled data is modified.

=back

A nifty example is

	( <<perl )
	$rlist = ReadData(\'{ foo = bar; }');	# ReadData is auto-exported from Data/Rlist.pm
	perl

which coerces the  already compiled Rlist (some array)  into a hash.  Provided with  such an input,
F<parse()> is then forced to return

	{ 'foo' => 'bar' }

You can  also F<eval>  all embedded  codes on your  own; they're  returned by  the F<nanoscripts()>
method.  See also F<result()>.

=head2 Comments

Rlist  supports multiple  forms  of comments:  F<//>  or F<#>  single-line-comments,  and F</*  */>
multi-line-comments. You may use all three forms at will.

=head2 Compile Options

The format  of the  compiled text and  the behavior  of F<L</compile>()> can  be controlled  by the
OPTIONS parameter  of F<L</write>()>, F<L</write_string>()> etc.   The argument is  a hash defining
how the Rlist text shall be formatted. The following pairs are recognized:

=over

=item 'precision' =E<gt> PLACES

Make F<L</compile>()> round all numbers to PLACES decimal places, by calling F<L</round>()> on each
scalar that L<looks like a number|/is_number>.  By default PLACES is F<undef>, which means floats
are not rounded.

=item 'scientific' =E<gt> FLAG

Causes F<L</compile>()> to masquerade F<$Data::Rlist::RoundScientific>.  See F<L</round>()> for
what this means.

=item 'code_refs' =E<gt> TOKEN

Defines how F<L</compile>()> shall treat F<CODE> reference.  Legal values for TOKEN are 0 (the
default), C<"call"> and C<"deparse">.

A TOKEN value of 0 compiles subroutine references into the string C<"?CODE?">. A value of C<"call">
calls the code, then compiles the return value.  C<"deparse"> serializes the code using
F<B::Deparse>, which reproduces the Perl source. Note that it then makes sense to enable
C<"here_docs"> (see below), because otherwise the deparsed code will be in one string with LFs
quoted as C<"\n">.  This causes no harm, but when opened in a text editor the data will be more
legible.

=item 'threads' =E<gt> COUNT

If enabled F<L</compile>()> internally use multiple threads.  Note that this makes only sense on
machines with at least COUNT CPUs.

=item 'here_docs' =E<gt> FLAG

If enabled strings with at least two newlines in them are written as
L<here-document|/Here-Documents>, when possible.  To qualify as here-document a string has to have
at least two LFs (C<"\n">), one of which must terminate it.

=item 'auto_quote' =E<gt> FLAG

When true (default) do not quote strings that look like identifiers (determined by
F<L</is_symbol>()>).  When false quote F<all> strings.  Hash keys are not affected.

F<L</write_csv>()> and F<L</write_conf>()> interpret this flag differently.  False means not to
quote at all.  True quotes only strings that don't look like numbers and that aren't yet quoted.

=item 'outline_data' =E<gt> NUMBER

Use C<"eol_space"> (linefeed) to "distribute data on many lines."  Insert a linefeed after every
NUMBERth array value; 0 disables outlining.

=item 'outline_hashes' =E<gt> FLAG

If enabled, and C<"outline_data"> is also enabled, prints F<{> and F<}> on distinct lines when
compiling Perl hashes with at least one pair.

=item 'separator' =E<gt> STRING

The comma-separator string to be used by F<L</write_csv>()>.  The default is C<','>.

=item 'delimiter' =E<gt> REGEX

Field-delimiter for F<L</read_csv>()>.  There is no default value.  To read configuration files,
for example, you may use C<'\s*=\s*'> or C<'\s+'>; and to read CSV-files you may use
C<'\s*[,;]\s*'>.

=back

The following options format the generated Rlist; normally you don't want to modify them:

=over

=item 'bol_tabs' =E<gt> COUNT

Count of physical, horizontal TAB characters to use at the begin-of-line per indentation
level. Defaults to 1. Note that we don't use blanks, because they blow up the size of generated
text without measure.

=item 'eol_space' =E<gt> STRING

End-of-line string to use (the linefeed).  For example, legal values are C<"">, C<" ">, C<"\n">,
C<"\r\n"> etc. The default is F<undef>, which means to use the current value of F<$/>.

Note that this is a compile-option that  only affects F<compile()>.  When parsing files the builtin
F<readline> function is called, which uses F<$/>.

=item 'paren_space' =E<gt> STRING

String to write after F<(> and F<{>, and before F<}> and F<)> when compiling arrays and hashes.

=item 'comma_punct' =E<gt> STRING

=item 'semicolon_punct' =E<gt> STRING

Comma and semicolon strings, which shall be at least C<","> and C<";">.  No matter what,
F<L</compile>()> will always print the C<"eol_space"> string after the C<"semicolon_punct"> string.

=item 'assign_punct' =E<gt> STRING

String to make up key/value-pairs. Defaults to C<" = ">.  Note that this is a compile option: the
parser always expects some C<"="> to designate a pair.

=back

=head3 Predefined Options

The L<OPTIONS|/Compile Options> parameter accepted by some package functions is either a hash-ref
or the name of a predefined set:

=over

=item 'default'

Default if writing to a file.

=item 'string'

Compact, no newlines/here-docs. Renders a "string of data".

=item 'outlined'

Optimize the compiled Rlist for maximum readability.

=item 'squeezed'

Very compact, no whitespace at all. For very large Rlists.

=item 'perl'

Compile data in Perl syntax, using F<L</compile_Perl>()>, not F<L</compile>()>.  The output then
can be F<eval>'d, but it cannot be F<L</read>()> back.

=item 'fast' or F<undef>

Compile data as fast as possible, using F<L</compile_fast>()>, not F<L</compile>()>.

=back

All   functions   that   define   an   L<OPTIONS|/Compile  Options>   parameter   implicitly   call
F<L</complete_options>()>  to  complete  the  argument   from  one  of  the  predefined  sets,  and
C<"default">.  Therefore  you may just define  a "lazy subset  of options" to these  functions. For
example,

    my $obj = new Data::Rlist(-data => $thing);

    $obj->write('thing.rls', { scientific => 1, precision => 8 });

=head2 Debugging Data (Finding Self-References)

To  reduce recursive data  structures (into  true hierachies)  set F<$Data::Rlist::MaxDepth>  to an
integer above 0.  It then defines the  depth under which F<L</compile>()> shall not venture deeper.
The compilation of Perl data (into Rlist text)  then continues, but on F<STDERR> a message like the
following is printed:

    ERROR: compile2() broken in deep ARRAY(0x101aaeec) (depth = 101, max-depth = 100)

This  message will  also be  repeated as  comment when  the compiled  Rlist is  written to  a file.
Furthermore  F<$Data::Rlist::Broken>  is  incremented  by  one. While  the  compilation  continues,
effectively  any  attempt to  venture  deeper as  suggested  by  F<$Data::Rlist::MaxDepth> will  be
blocked.  See also F<L</broken>()>.

=head2 Debugging Parsing/Compiling

Setting  F<$Data::Rlist::DEBUG>  to  a true  value  prints  many  useful  messages on  STDERR  when
reading/writing data.

=cut

package Data::Rlist;

use strict;
use warnings;
use Exporter;
use Carp;
use Scalar::Util qw/reftype/;
use integer;

use vars qw/$VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS

            %PredefinedOptions $DEBUG
            $RoundScientific $SafeCppMode $EchoStderr
            $R $Fh $Locked $DefaultMaxDepth $MaxDepth $Depth
            $Errors $Warnings $Broken $MissingInput @Messages
            $DefaultCsvDelimiter $DefaultConfDelimiter $DefaultConfSeparator
            $DefaultNanoscriptToken

            $REPunctuationCharacter $REIntegerHere $REFloatHere
            $RESymbolCharacter $RESymbolHere $REStringHere
            $REInteger $REFloat
            $RESymbol $REString $REValue
			@REIsPunct @REIsDigit
           /;

# Parser/lexer variables.  Used by open_input, parse and lex. Declaring them as lexicals is
# slightly faster than to 'use vars'.

my($Readstruct, $ReadFh, $Ln, $LnArray);
my(%Rules, @VStk, @NStk);

use constant DEFAULT_VALUE => qq'""'; # default Rlist, the empty string

BEGIN {
    $VERSION = '1.41';
    $DEBUG = 0;
    @ISA = qw/Exporter/;

    # Always exported (:DEFAULT) when the package is fetched with "use", not "required".

    @EXPORT = qw/ReadCSV WriteCSV
                 ReadConf WriteConf
                 ReadData WriteData
                 PrintData OutlineData StringizeData SqueezeData
                 KeelhaulData CompareData/;

    # Symbols exported on request.

    @EXPORT_OK = qw/:DEFAULT

                    predefined_options complete_options

                    maybe_quote quote escape unquote unescape unhere
                    is_value is_random_text is_symbol is_integer is_number
                    split_quoted parse_quoted

                    equal round

                    keelhaul deep_compare fork_and_wait synthesize_pathname

                    $REInteger $REFloat $RESymbol/;

    %EXPORT_TAGS = (# Handle IEEE numbers
                    floats => [@EXPORT, qw/equal round is_number is_integer/],
                    # Handle (quoted) strings
                    strings => [@EXPORT, qw/maybe_quote quote escape
                                            unquote unescape unhere
                                            is_value is_random_text is_number is_integer is_symbol
                                            split_quoted parse_quoted/],
                    # Compile options
                    options => [@EXPORT, qw/predefined_options complete_options/],
                    # Auxiliary functions
                    aux => [@EXPORT, qw/keelhaul deep_compare fork_and_wait synthesize_pathname/]);

    $MaxDepth = 0; $DefaultMaxDepth = 100; $Broken = 0;
    $SafeCppMode = 0;
	$EchoStderr = 0;
    $RoundScientific = 0;
    $DefaultConfSeparator = ' = ';
    $DefaultConfDelimiter = '\s*=\s*';
    $DefaultCsvDelimiter = '\s*,\s*';
    $DefaultNanoscriptToken = 'perl';

    %PredefinedOptions =
    (
     default =>
     {
      # Warning: "code_refs" are disabled by default because compile_fast() (the default compile
      # function) never calls subs.  Likewise the default "precision" must be undef!
      eol_space => "\n",
      bol_tabs => 1,
      outline_hashes => 0,
      outline_data => 6,
      paren_space => '',
      comma_punct => ', ',
      semicolon_punct => ';',
      assign_punct => ' = ',
      here_docs => 1,
      auto_quote => undef,      # let write() and write_csv() choose their defaults
      code_refs => 0,
      scientific => 0,
      separator => ',',
      delimiter => undef,
      precision => undef
     },

     string =>
     {
      eol_space => '',
      bol_tabs => 0,
      outline_data => 0,
      here_docs => 0
     },

     outlined =>
     {
      eol_space => "\n",
      bol_tabs => 1,
      outline_hashes => 1,
      outline_data => 1,
      paren_space => ' ',
      comma_punct => ', ',
     },

     squeezed =>
     {
      bol_tabs => 0,
      eol_space => '',
      outline_hashes => 0,
      outline_data => 0,
      here_docs => 0,
      code_refs => 0,
      paren_space => '',
      comma_punct => ',',
      assign_punct => '=',
      precision => 6,
     }
    );

    ########
    # Regular expressions for scalars
    #
    # $RESymbolHere shall be defined equal to the 'identifier' regex in 'rlist.l', to keep the
    # C/C++ and Perl implementations be compatible.  See also the C++ function quote() and the
    # {identifier} rule in <rlist.l>
    #
	# In Perl regexes, by default the "^" character matches only the beginning of the string, the
    # "$" character only the end (or before the newline at the end). The "/s" modifier will force
    # "^" to match only at the beginning of the string and "$" to match only at the end (or just
    # before a newline at the end) of the string.  "$" hence ignores an optional trailing newline.
    #
    # When "/m" is used this means for "foo\nbar" the "$" matches the end of the string (after "r")
    # and also before every line break (between "o" and "\n").  Therefore we've to use "\z" which
    # matches only at the end of the string.

    $REIntegerHere = '[+-]?\d+';
    $REFloatHere = '(?:[+-]?)(?=\d|\.\d)\d*(?:\.\d*)?(?:[Ee](?:[+-]?\d+))?';
    $REPunctuationCharacter = '\=\,;\{\}\(\)';
    $RESymbolCharacter = 'a-zA-Z_0-9\-/\~:\.@';
    $RESymbolHere = '[a-zA-Z_\-/\~:@]'.qq'[$RESymbolCharacter]*';
    $REStringHere = '"[^"\\\r\n]*(?:\\.[^"\\\r\n]*)*"'; # " allowed inside the quotes, but only as \"

    $REInteger = qr/^$REIntegerHere\z/;
    $REFloat = qr/^$REFloatHere\z/;
    $RESymbol = qr/^$RESymbolHere\z/;
    $REString = qr/^$REStringHere\z/;

    $REValue = qr/$REString|
                  $REInteger|
                  $REFloat|
                  $RESymbol/x;

    $REValue = qr/^$REStringHere\z|
                  ^$REIntegerHere\z|
                  ^$REFloatHere\z|
                  ^$RESymbolHere\z/x if 0; # disabled because it is slightly slower

    ########
    # Rlist parser map:
    #
    #   token => [ rule, deduce-function ]
    #   rule  => [ rule, deduce-function ]
    #
    # See `lex()' for token meanings.

	sub syntax_error($;$) {
		my($msg, $tr) = (shift, shift||'??');
		$msg =~ s/\s/ /go; pr1nt('ERROR', $msg);
		$Errors++; $tr
	}
	sub warning($;$) {
		my($msg, $tr) = (shift, shift||'');
		$msg =~ s/\s/ /go; pr1nt('WARNING', $msg);
		$Warnings++; $tr
	}

    %Rules =
    (#
	 # Key/value pairs.
	 #
	 # For nanoscripts (n) push hash-ref, key and the script to @NStk.
	 #

     '{}'	=> sub { push @VStk, { }; 'v' },
     '{h}'  => sub { 'v' },
	 # first pairs (open the hash)
 	 'v;'	=> sub { push @VStk, { pop(@VStk) => '' }; 'h' },
     'v=v;'	=> sub { push @VStk, { splice @VStk, -2 }; 'h' },
     'v=n;'	=> sub { my($k, $v) = splice @VStk, -2;
					 my $h = { $k => $v };
					 push @VStk, $h; push @NStk, [ $h, $k, $v ]; 'h' },
	 # subsequent pairs (complete the hash)
 	 'hv;'	=> sub { my $k      = pop @VStk;	    $VStk[$#VStk]->{$k} = ''; 'h' },
     'hv=v' => sub { my($k, $v) = splice @VStk, -2; $VStk[$#VStk]->{$k} = $v; 'h' },
     'hv=n' => sub { my($k, $v) = splice @VStk, -2; $VStk[$#VStk]->{$k} = $v; push @NStk, [ $VStk[$#VStk], $k, $v ]; 'h' },
	 'h;'	=> sub { 'h' },

	 #
	 # Single values/scripts.
	 #

     '()'   => sub { push @VStk, [ ]; 'v' },
     '(l)'  => sub { 'v' },
     '(v)'  => sub {                    push @VStk, [pop(@VStk)]; 'v' },
     '(n)'  => sub { my $v = pop @VStk; push @VStk, [ $v ]; push @NStk, [ $VStk[$#VStk], 0, $v ]; 'v' },
     'v,'	=> sub {                    push @VStk, [pop(@VStk)]; 'l,' },
     'n,'	=> sub { my $v = pop @VStk; push @VStk, [ $v ]; push @NStk, [ $VStk[$#VStk], 0, $v ]; 'l,' },
     'l,v'	=> sub { my $v = pop @VStk; push @{$VStk[$#VStk]}, $v; 'l' }, # push to existing list
     'l,n'	=> sub { my $v = pop @VStk; push @{$VStk[$#VStk]}, $v; push @NStk, [ $VStk[$#VStk], $#{$VStk[$#VStk]}, $v ]; 'l' },

	 #
	 # Rules for syntax errors.  All rules containing '??' are error-recovery-rules.
	 #

	 '=??'	=> sub { syntax_error("invalid value after '='", ';') },
	 '??;'	=> sub { syntax_error("invalid key/value before ';'", ';') },
	 ',??'	=> sub { push @VStk, ''; syntax_error("invalid value after ','", ',v') },
     '??'	=> sub { '' },

     'vv'	=> sub { my($k, $v) = splice @VStk, -2; syntax_error("missing ',' or ';'") },
     'v=v}' => sub { my($k, $v) = splice @VStk, -2; push @VStk, { $k => $v }; warning("unterminated pair: expected ';'", 'h}') },
     'v=v,' => sub { my($k, $v) = splice @VStk, -2; warning("pair terminated with ',': expected ';'", '??') },
     'v=;'	=> sub { warning("missing value, or superfluous '='", 'v;') },
     'v=}'	=> sub { warning("missing value: expected ';', not '}'", 'v;') },
     '(v}'	=> sub { my $v = pop @VStk; syntax_error("expected ')' after value, not '}'") },
     '{v)'	=> sub { my $v = pop @VStk; syntax_error("expected '(' before value, not '{'") },
     '{v}'	=> sub { my $k = pop @VStk; push @VStk, { $k => '' }; warning("unterminated pair: expected ';'", 'h') },

     '(v,)'	=> sub { warning("superfluous ',' at end of list", '(v)') },
     '(l,)' => sub { warning("superfluous ',' at end of list",  'v') },

     '{{'	=> sub { warning("non-scalar hash-key", '??') },
     '{('	=> sub { warning("non-scalar hash-key", '??') },

	 'n;'	=> sub { warning("nanoscript ignored: shall be def'd as value, not key", 'v;') },
	 'n=v;'	=> sub { warning("nanoscript ignored: shall be def'd as value, not key", 'v=v;') },
    );

	# True syntax errors, which cannot be converted into valid rules.  The error will be printed
	# and recorded in @Messages when '??' is actually reduced.

    foreach my $errrule ((',,', ',;', ';,', ';;',
						  '{=', '{,', '{;',
						  '(=', '(,', '(;',
						  '==',
						  '(v;', '(n;',
						  'v=,', 'v=)')) {
		die if exists $Rules{$errrule};
        $Rules{$errrule} = eval(<<___);
	sub { my \@r = map { s/\\s+/ /g; \$_ } map { if (/[vnhl]/) { pop(\@VStk) }; s/v/value/; s/n/nanoscript/; s/h/hash/; s/l/list/; \$_ }
				   split / */, '$errrule';
		  return syntax_error("'".join(' ', \@r)."'"); }
___
    }

    my($rule_max, $rule_min) = (0, 9);
    foreach (keys %Rules) {
        $rule_min = length($_) if length($_) < $rule_min;
        $rule_max = length($_) if length($_) > $rule_max;
    }
    die $rule_min if $rule_min != 2;
    die $rule_max if $rule_max != 4;
}

sub pr1nt(@)
{
    # This function is used to write a new comment line (usually some sort of error message) into
    # the currently compiled file, and to STDERR (if $Data::Rlist::DEBUG).

    my $label = shift;
	my $msg = join(': ', grep { length }
				   ($label,
					((defined($Readstruct) &&
					  exists $Readstruct->{filename}) ? $Readstruct->{filename}."($.)" : ""),
					grep { defined } @_))."\n";
    foreach my $fh (grep { defined } ($Fh, $EchoStderr ? *STDERR{IO} : undef)) {
        next unless defined $fh;
        print $fh map { $fh == defined($Fh) ? "# $_" : $_ } $msg;
    }
	push @Messages, $msg;
}

=head1 PACKAGE FUNCTIONS

The core functions to cultivate package objects are F<new()>, F<dock()>, F<set()> and F<L</get>()>.
When a regular package  function is called in object context some or  all arguments can be omitted.
They  will  be  reused  from  object  attributes.   This  is  true  for  the  following  functions:
F<L</read>()>,  F<L</write>()>,   F<L</read_string>()>,  F<L</write_string>()>,  F<L</read_csv>()>,
F<L</write_csv>()>, F<L</read_conf>()>, F<L</write_conf>()> and F<L</keelhaul>()>.

When  not called  in  object context,  however, the  first  argument has  an indifferent  meaning.
F<L</read>()> expects an input file or string, F<L</write>()> the data to compile etc.

=head2 Construction

=head3 F<new([ATTRIBUTES])>

Create a F<Data::Rlist> object from the hash ATTRIBUTES. Attributes are key/value pairs. For
example,

    $self = Data::Rlist->new(-input => 'this.dat',
                             -data => $thing,
                             -output => 'that.dat');

creates an object  on which F<$self-E<gt>read()> reads from  F<this.dat>, and F<$self-E<gt>write()>
writes F<$thing> to F<that.dat>.

B<REGULAR OBJECT ATTRIBUTES>

=over 4

=item C<-input =E<gt> INPUT>

Defines what Rlist text to parse. INPUT shall be a filename or string reference.

=item C<-filter =E<gt> FILTER>

=item C<-filter_args =E<gt> FILTER-ARGS>

FILTER and FILTER-ARGS define how to preprocess an input file.  FILTER can be 1 to select the
standard C preprocessor F<cpp>.  These attributes are applied by F<L</read>()>,
F<L</read_string>()>, F<L</read_conf>()> and F<L</read_csv>()>.

=item C<-data =E<gt> DATA>

=item C<-output =E<gt> OUTPUT>

=item C<-options =E<gt> OPTIONS>

=item C<-header =E<gt> HEADER>

DATA defines  the Perl data  to be  L<compiled|/compile> into text.  OPTIONS define L<how  the data
shall be compiled|/Compile Options>,  and OUTPUT where to put it.  HEADER  defines the comments: an
array of text lines,  each of which will by prefixed  by a F<#> and then written at  the top of the
output   file.    These   attributes   are  applied   by   F<L</write>()>,   F<L</write_string>()>,
F<L</write_conf>()>, F<L</write_csv>()> and F<L</keelhaul>()>.

=item C<-delimiter =E<gt> DELIMITER>

Defines the field delimiter for F<.csv>-files. Applied by F<L</read_csv>()> and F<L</read_conf>()>.

=item C<-columns =E<gt> STRINGS>

Defines  the  column names  for  F<.csv>-files,  then written  into  the  first  line.  Applied  by
F<L</write_csv>()> and F<L</write_conf>()>.

=back

B<ATTRIBUTES THAT MASQUERADE PACKAGE GLOBALS>

The attributes  listed below raise  new values for  package globals for  the time an  object method
runs.  Note that some globals of  these are also set from L<compile-time options|/Compile Options>,
and that compile options can be set per-object using F<-options>.

For  example, F<Data::Rlist::L</round>()>  is called  during compilation,  when  the C<"precision">
compile option  is defined, to round  all numbers to a  certain count of decimal  places.  When the
F<$Data::Rlist::RoundScientific> flag  is true, F<round()> formats  the number in  either normal or
exponential (scientific)  notation, whichever  is more appropriate  for its magnitude.   By setting
F<-RoundScientific> this sort of formatting can be enabled per object.

=over

=item C<-InputRecordSeparator =E<gt> FLAG>

Masquerades F<$/>, which affects how lines are read and written to and from Rlist- and CSV-files.
You may also set F<$/> by yourself.  See L<perlport> and L<perlvar>.

=item C<-MaxDepth =E<gt> INTEGER>

=item C<-SafeCppMode =E<gt> FLAG>

=item C<-RoundScientific =E<gt> FLAG>

Masquerades F<$Data::Rlist::MaxDepth>, F<$Data::Rlist::SafeCppMode> and
F<$Data::Rlist::RoundScientific>.

=item C<-EchoStderr =E<gt> FLAG>

Print read errors and warnings message on F<STDERR> (default: off).

=item C<-DefaultCsvDelimiter =E<gt> REGEX>

=item C<-DefaultConfDelimiter =E<gt> REGEX>

Masquerades F<$Data::Rlist::DefaultCsvDelimiter>  and F<$Data::Rlist::DefaultConfDelimiter>.  These
globals define  the default regexes  to use  when the F<-options>  attribute does not  specifiy the
L<C<"delimiter">|/Compile Options> regex.  Applied by F<L</read_csv>()> and F<L</read_conf>()>.

=item C<-DefaultConfSeparator =E<gt> STRING>

Masquerades F<$Data::Rlist::DefaultConfSeparator>,  the default string to use  when the F<-options>
attribute   does  not  specifiy   the  L<C<"separator">|/Compile   Options>  string.    Applied  by
F<L</write_conf>()>.

=back

=head3 F<dock(SELF, SUB)>

Exclusively  links some  object SELF  to the  package.  This  means that  some of  SELF's attribute
masqquerade  few  package  globals for  the  time  SUB  run.   SELF  then locks  the  package,  and
F<$Data::Rlist::Locked>  is true.   Here is  an  example for  input preprocessed  by F<cpp>,  which
temporarily sets F<$Data::Rlist::SafeCppMode> to 1:

	$self = Data::Rlist->new(-SafeCppMode => 1, -filter => 1);

=head2 Attribute Access

=head3 F<set(SELF[, ATTRIBUTE]...)>

Reset or initialize object attributes, then return SELF.  Each ATTRIBUTE is a name/value-pair.  See
F<L</new>()> for a list of valid names.  For example,

    $obj->set(-input => \$str, -output => 'temp.rls', -options => 'squeezed');

=head3 F<get(SELF, NAME[, DEFAULT])>

=head3 F<require(SELF[, NAME])>

=head3 F<has(SELF[, NAME])>

Get some  attribute NAME from object SELF.   Unless NAME exists returns  DEFAULT.  The F<require()>
method has  no default value,  hence it dies  unless NAME exists.  F<has()> returns true  when NAME
exists, false otherwise.  For NAME the leading hyphen is optional.  For example,

    $self->get('foo');          # returns $self->{-foo} or undef
    $self->get(-foo=>);         # dto.
    $self->get('foo', 42);      # returns $self->{-foo} or 42

=cut

sub new {
    my($prototype, $k) = shift;
    carp <<___ if @_ & 1;
$prototype->Data::Rlist::new(${\(join(', ', @_))})
    odd number of arguments supplied, expecting key/value pairs
___
    my %args = @_;
    bless { map { $k = $_;
                  s/^_+//o;			# remove leading underscores
                  s/^([^\-])/-$1/o; # prepend missing '-'
                  $_ => $args{$k}
              } keys %args }, ref($prototype) || $prototype;
}

sub set {
    my($self) = shift;
    my %attr = @_;
    while(my($k, $v) = each %attr) {
        $self->{$k} = $v
    } $self
}

sub require($$) {               # get attribute or confess
    my($self, $attr) = @_;
    my $v = $self->get($attr);
    confess "$self->require(): missing '$attr' attribute:\n\t\t".join("\n\t\t", map { "$_ = $self->{$_}" } keys %$self) unless defined $v;
    return $v;
}

sub get($$;$) {                 # get attribute or return default value/undef
    my($self, $attr, $default) = @_;
    $attr = '-'.$attr unless $attr =~ /^-/;
    return $self->{$attr} if exists $self->{$attr};
    return $default;
}

sub has($$) {
    my($self, $attr) = @_;
    $attr = '-'.$attr unless $attr =~ /^-/;
    exists $self->{$attr};
}

sub dock($\&) {
    carp "package Data::Rlist locked" if $Locked++; # TODO: use critical sections and atomic increment
    my ($self, $block) = @_;
    local $MaxDepth = $self->get(-MaxDepth=>) if $self->has(-MaxDepth=>);
    local $SafeCppMode = $self->get(-SafeCppMode=>) if $self->has(-SafeCppMode=>);
    local $EchoStderr = $self->get(-EchoStderr=>) if $self->has(-EchoStderr=>);
    local $RoundScientific = $self->get(-RoundScientific=>) if $self->has(-RoundScientific=>);
    local $DefaultCsvDelimiter = $self->get(-DefaultCsvDelimiter=>) if $self->has(-DefaultCsvDelimiter=>);
    local $DefaultConfDelimiter = $self->get(-DefaultConfDelimiter=>) if $self->has(-DefaultConfDelimiter=>);
    local $DefaultConfSeparator = $self->get(-DefaultConfSeparator=>) if $self->has(-DefaultConfSeparator=>);
    local $DefaultNanoscriptToken = $self->get(-DefaultNanoscriptToken=>) if $self->has(-DefaultNanoscriptToken=>);
    local $DEBUG = $self->get(-DEBUG=>) if $self->has(-DEBUG=>);
    local $/ = $self->get(-InputRecordSeparator=>) if $self->has(-InputRecordSeparator=>);
	local $R;
    if (wantarray) {
        my @r = $block->(); --$Locked; return @r;
    } else {
        my $r = $block->(); --$Locked; return $r;
    }
}

=head2 Public Interface

=head3 F<read(INPUT[, FILTER, FILTER-ARGS])>

Parse data from INPUT, which specifies some Rlist-text.  See also F<L</errors>()>, F<L</write>()>.

B<PARAMETERS>

INPUT shall be either

- some Rlist object created by F<L</new>()>,

- a string reference, in which case F<read()> and F<L</read_string>()> parse Rlist text from it,

- a string scalar, in which case F<read()> assumes a file to parse.

See F<L</open_input>()> for the FILTER and  FILTER-ARGS parameters, which are used to preprocess an
input file.  When an input file cannot  be F<open>'d and F<flock>'d this function dies.  When INPUT
is an  object you  specify FILTER and  FILTER-ARGS to  overload the F<-filter>  and F<-filter_args>
attributes.

B<RESULT>

F<L</read>()> returns  the parsed data  as array-  or hash-reference, or  F<undef> if there  was no
data. The latter may also be the case when file consist only of comments/whitespace.

B<NOTES>

This function may die.  Dying is Perl's mechanism to raise exceptions, which eventually can be
catched with F<eval>.  For example,

    my $host = eval { use Sys::Hostname; hostname; } || 'some unknown machine';

This code fragment  traps the F<die> exception to  that F<eval> returns F<undef>, or  the result of
calling F<hostname>. The following example uses F<eval> to trap exceptions thrown by F<read()>:

    $object = new Data::Rlist(-input => $thingfile);
    $thing = eval { $self->read };

    unless (defined $thing) {
        if ($self->errors) {
            print STDERR "$thingfile has syntax errors"
        } else {
            print STDERR "$thingfile not found, is locked or empty"
        }
    } else {
        # Can use $thing
            .
            .
    }

=head3 F<read_csv(INPUT[, OPTIONS, FILTER, FILTER-ARGS])>

=head3 F<read_conf(INPUT[, OPTIONS, FILTER, FILTER-ARGS])>

Parse data from INPUT, which specifies some comma-separated-values (CSV) text.  Both functions

- read data from strings or files,

- use an optional delimiter,

- ignore delimiters in quoted strings,

- ignore empty lines,

- ignore lines begun with F<#>.

F<read_conf()> is a variant of F<read_csv()> dedicated to configuration files. Such files consist
of lines of the form

    key = value

That is, F<read_conf()>  simply uses a default delimiter of  C<'\s*=\s*'>, while F<read_csv()> uses
C<'\s*,\s*'>.  Hence  F<read_csv()> can  be used as  well for  configuration files. For  example, a
delimiter  of C<'\s+'>  splits the  line at  horizontal whitespace  into multiple  values  (but, of
course,   not  from   within  quoted   strings).   For   more  information   see  F<L</ReadCSV>()>,
F<L</ReadConf>()>, F<L</write_csv>()> and F<L</write_conf>()>.

B<PARAMETERS>

For INPUT see F<L</read>()>.  For FILTER, FILTER-ARGS see F<L</open_input>()>.  OPTIONS can be used
to set the  L<C<"delimiter">|/Compile Options> regex.  For F<read_csv()>  the delimiter defaults to
C<'\s*,\s*'>,  and  for  F<read_conf()>  to  C<'\s*=\s*'>.   These  defaults  are  defined  by  the
F<$Data::Rlist::DefaultCsvDelimiter> and F<$Data::Rlist::DefaultConfDelimiter>.

B<RESULT>

Both functions return a  list of lists.  Each embedded array defines the fields  in a line, and may
be of variable length.

B<EXAMPLES>

Un/quoting of values happens implicitly.  Given a file F<db.conf>

    # Comment
    SERVER      = hostname
    DATABASE    = database_name
    LOGIN       = "user,password"

the call

    $opts = Data::Rlist::read_conf('db.conf');

returns (as F<$opts>)

    [ [ 'SERVER', 'hostname' ],
      [ 'DATABASE', 'database_name' ],
      [ 'LOGIN', 'user,password' ]
    ]

To convert such an array into a hash C<%conf>, use

    %conf = map { @$_ } @{ReadConf 'db.conf'};

The F<L</write_conf>()> function can be used to update F<db.conf> from F<$opts>, so that

    push @$opts, [ 'MAGIC VALUE' => 3.14_15 ];

    Data::Rlist::write_conf('db.conf', { precision => 2 });

yields

    SERVER = hostname
    DATABASE = database_name
    LOGIN = "user,password"
    "MAGIC VALUE" = 3.1415

=head3 F<read_string(INPUT)>

Calls F<L</read>()> to parse Rlist language  productions from the string or string-reference INPUT.
INPUT  may  be  an  object-reference,  in   which  case  F<read_string()>  attempts  to  parse  the
string-reference defined by the F<-input> attribute.

=head3 F<result([SELF])>

Return  the last  result of  calling F<L</read()>>,  which  is either  F<undef> or  some array-  or
hash-reference.  When  called as method (i.e., SELF  is specified) returns the  result that occured
the last time SELF had called F<L</read>()>.

=head3 F<nanoscripts([SELF])>

Return F<undef>  or an array-ref of  nanoscripts defined by  the last call to  F<L</read>()>.  When
called as method  returns the nanoscripts defined  by the last time SELF  had called F<L</read>()>.
The result has the form:

	[ [ $hash_or_array_ref, $key_or_index ], # 1st nanoscript
	  [ $hash_or_array_ref, $key_or_index ], # 2nd nanoscript
		.
		.
		.
	]

This information defines the location of the embedded Perl script, which can then be F<eval>d.  See
als F<evaluate_nanoscripts()>.

=head3 F<evaluate_nanoscripts([SELF])>

Evaluates  all nanoscripts  defined  by the  last call  to  F<L</read>()>.  When  called as  method
evaluates the  nanoscripts defined  by the last  time SELF  had called F<L</read>()>.   Returns the
number  of  scripts  or  0  if   none  were  available.   The  evaluation  happens  L<as  described
here|/Embedded Perl Code>.  In short, each embedded piece of Perl sees the data, and is replaced by
the result of F<eval>'ing it.  You can F<eval>  embedded codes on your own, by processing the array
returned by the F<nanoscripts()> function.

=head3 F<messages([SELF])>, F<errors([SELF])>, F<warnings([SELF])>

Returns  the array  of messages  / syntax  errors  / warnings  that occurred  in the  last call  to
F<L</read>()>.  Returns a list of strings.  When called as method returns the messages that occured
the last time SELF had called F<L</read>()>.

=head3 F<broken([SELF])>

Returns   the   number    of   times   the   last   F<L</compile>()>    crossed   the   zenith   of
F<$Data::Rlist::MaxDepth>. When called as method returns the information for the last time SELF had
called  F<L</compile>()>.   Note  that  F<L</compile>()>   is  not  called  directly,  but  through
F<L</write>()>.

=head3 F<missing_input([SELF])>

Returns true when  the last call to  F<L</parse>()> yielded F<undef>, because there  was nothing to
parse.   When  called  as method  returns  the  information  for  the  last time  SELF  had  called
F<L</read>()>.

=cut

sub is_integer(\$);
sub is_number(\$);
sub is_symbol(\$);
sub is_random_text(\$);

sub read($;$$);
sub read($;$$) {
    my($input, $fcmd, $fcmdargs) = @_;

    if (ref($input) eq __PACKAGE__) {
        # $input is an object created by Data::Rlist::new
        $input->dock(sub {
						 unless ($fcmd) {
							 $fcmd = $input->get('-filter');
							 $fcmdargs = $input->get('-filter_args');
						 }
						 $R = Data::Rlist::read($input->require(-input=>), $fcmd, $fcmdargs); # returns a reference
						 $input->set(-read_result => [$Warnings, $Errors, $Broken, $MissingInput, \@Messages]);
						 $input->set(-nanoscripts => (@NStk ? [@NStk] : undef));
						 $input->set(-result => $R);
						 $R
					 }
					)
    } else {
        # $input is either a string (filename) or reference.
        local $| = 1 if $DEBUG;
		if ($DEBUG) {
			print STDERR "Data::Rlist::open_input($input, $fcmd, $fcmdargs)\n" if $fcmd && $fcmdargs;
			print STDERR "Data::Rlist::open_input($input, $fcmd)\n" if $fcmd && !$fcmdargs;
			print STDERR "Data::Rlist::open_input($input)\n" unless $fcmd;
		}
        return undef unless open_input($input, $fcmd, $fcmdargs);
        confess unless defined $Readstruct;
        my $data = parse();
        print STDERR "Data::Rlist::close_input() parser result = ", (defined $data) ? $data : 'undef', "\n" if $DEBUG;
        close_input();
        return $data;
    }
}

sub read_csv($;$$$);
sub read_csv($;$$$) {
    my($input, $options, $fcmd, $fcmdargs) = @_;

    if (ref($input) eq __PACKAGE__) {
        # $input is an object created by Data::Rlist::new
        $input->dock
        (sub {
             $options ||= $input->get('options');
             $fcmd ||= $input->get('filter');
             $fcmdargs ||= $input->get('filter_args');
             $input = $input->get('input');
             Data::Rlist::read_csv($input, $options, $fcmd, $fcmdargs);
         });
    } else {
        # $input is either a scalar or string-reference: we'll read linewise from a file or a
        # string now.  In case $input is a reference (string) open_input() does not call
        # read_csv(), but splits at LF or CR+LF.  However, lexln() only chomps $/. Therefore we
        # explicitly check for a trailing \r here.

        return undef unless open_input($input, $fcmd, $fcmdargs);
        confess unless defined $Readstruct;
        my $delim = complete_options($options)->{delimiter} || $DefaultCsvDelimiter;
        my @L; push @L, $Ln while lexln();
        my @R; push @R, map { [ map { maybe_unquote($_) } split_quoted($_, $delim) ] }
		grep { not /^\s*#|^\s*$/o } # throw away comment lines and blank lines
		#map { s/\r+$//o; $_ }		# strip trailing \r
		@L;
        close_input();
        return \@R;
    }
}

sub read_conf(@) { 
    my($input, $options, $fcmd, $fcmdargs) = @_;
    $options ||= $input->get('options') if ref($input) eq __PACKAGE__;
    $options = complete_options($options) unless ref $options; # expand using predef'd set "default"
    $options->{delimiter} ||= $DefaultConfDelimiter;           # ...where "delimiter" is undef
    return read_csv($input, $options, $fcmd, $fcmdargs);
}

sub read_string($);
sub read_string($) {
    my $r = shift;
    if (defined($r) and not defined reftype($r)) {
        return read_string(\$r);
    } elsif (reftype($r) ne 'SCALAR') {
        carp 'string or string-reference required';
    } Data::Rlist::read($r);
}

sub result(;$) {
    my $self = shift;
	return $self->get(-result=>) if $self;
    return $R;
}

sub nanoscripts(;$) {
    my $self = shift;
	return $self->get(-nanoscripts=>) if $self;
    return @NStk ? \@NStk : undef;
}

sub evaluate_nanoscripts(;$) {
	my $self = shift;
	my $ns = nanoscripts($self);
	my $count = 0;
	if ($ns) {
		my $Rlist = result($self);
		foreach (@$ns) {
			my($this, $where, $copy_of_code) = @$_; ++$count;
			if (ref($this) =~ 'ARRAY') {
				my $i = int($where);
				my $code = $this->[$i];
				die unless $code eq $copy_of_code;
				print "evaluating nanoscript $this\->[$i]:\n\t${\(escape($code))}\n" if $DEBUG;
				$this->[$i] = eval $code;
				print "\n\tresult: $this->[$i]\n" if $DEBUG;
			} else {
				die unless ref($this) =~ 'HASH';
				my $code = $this->{$where};
				die unless $code eq $copy_of_code;
				print "evaluating nanoscript $this\->{$where}:\n\t${\(escape($code))}\n" if $DEBUG;
				$this->{$where} = eval $code;
				print "\n\tresult: $this->{$where}\n" if $DEBUG;
			}
		}
	} return $count;
}

sub warnings(;$) {
    my $self = shift;
    if ($self) {
        my $a = $self->get(-read_result=>);
        return $a->[0] if ref $a;
        return 0;
    } $Warnings
}

sub errors(;$) {
    my $self = shift;
    if ($self) {
        my $a = $self->get(-read_result=>);
        return $a->[1] if ref $a;
        return 0;
    } $Errors
}

sub broken(;$) {
    my $self = shift;
    if ($self) {
        my $a = $self->get(-read_result=>);
        return $a->[2] if ref $a;
        return 0;
    } $Broken
}

sub missing_input(;$) {
    my $self = shift;
    if ($self) {
        my $a = $self->get(-read_result=>);
        return $a->[3] if ref $a;
        return 0;
    } $MissingInput
}

sub messages(;$) {
    my $self = shift;
    if ($self) {
        my $a = $self->get(-read_result=>);
        return @{$a->[4]} if ref $a;
    } return ();
}

=head3 F<write(DATA[, OUTPUT, OPTIONS, HEADER])>

Transliterates Perl data into Rlist text.  F<write()> is auto-exported as F<L</WriteData>()>.

B<PARAMETERS>

DATA is either an object generated by F<L</new>()>, or any Perl data including F<undef>.  When DATA
is  some  F<Data::Rlist>  object  the  Perl  data  to  be  compiled  is  defined  by  its  F<-data>
attribute. (When F<-data> refers to another Rlist object, this other object is invoked.)

OUTPUT defines  the place where to compile  to (filename or some  string-reference).  When F<undef>
writes  to some  new string  to which  it returns  a reference  OUTPUT defaults  to  the F<-output>
attribute when DATA defines an object.

OPTIONS  defines how  to compile  the text  from DATA.   The argument  defaults to  the F<-options>
attribute when  DATA is  an object.   When F<undef> or  C<"fast"> uses  F<L</compile_fast>()>, when
C<"perl"> uses F<L</compile_Perl>()>, otherwise F<L</compile>()>.

HEADER is  a reference to  an array of  strings that shall  be printed literally  at the top  of an
output file. Defaults to the F<-header> attribute when DATA is an object.

B<RESULT>

When F<write()> creates a  file it returns 0 for failure or 1 for  success.  Otherwise it returns a
string reference.

B<EXAMPLES>

    $self = new Data::Rlist(-data => $thing, -output => $output);

    $self->write;   # Compile $thing into a file ($output is a filename)
                    # or string ($output is a string reference).

    Data::Rlist::write($thing, $output);    # dto., but using the functional interface.

    print $self->make_string;               # Print $thing to STDOUT.
    print Data::Rlist::make_string($thing); # dto.
    PrintData($thing);                      # dto.

=head3 F<write_csv(DATA[, OUTPUT, OPTIONS, COLUMNS, HEADER])>

=head3 F<write_conf(DATA[, OUTPUT, OPTIONS, HEADER])>

Write  DATA as  comma-separated-values  (CSV) to  file  or string  OUTPUT.  F<write_conf()>  writes
configuration  files where  each  line contains  a  tagname, a  separator and  a  value.  The  main
difference between F<write_conf()> and F<write_csv()> are the default values for C<"separator"> and
C<"auto_quote">.

B<PARAMETERS>

For DATA and OUTPUT  see F<L</write>()>. DATA defines the data to be  compiled.  But because of the
limitations of CSV-files this may not be just any Perl data.  It must be a reference to an array of
array references.  For example,

    [ [ a, b, c ],      # line 1
      [ d, e, f, g ],   # line 2
        .
        .
    ]

and for F<write_conf()>

    [ [ tag, value ],   # line 1
        .
        .
    ]

From  L<OPTIONS|/Compile  Options> is  read  the  comma-separator  (C<"separator">), how  to  quote
(C<"auto_quote">), the  linefeed (C<"eol_space">) and the numeric  precision (C<"precision">).  The
defaults are:

    FUNCTION        SEPARATOR   AUTO-QUOTING
    --------        ---------   ------------
    write_csv()     ','         no
    write_conf()    ' = '       yes

Optionally COLUMNS  (as an array-referernce) specify  the column names  to be written as  the first
line.  The optional HEADER  array is written as F<#>-comments before the  actual data.  When called
as methods, DATA, OPTIONS,  COLUMNS and HEADER defaults to the value  of the F<-data>, F<-options>,
F<-columns> and F<-header> attributes.

Note that F<write_csv()> uses  the current value of F<$/> to separate  lines. When called as method
you may temporarily overload F<$/> using the F<-InputRecordSeparator> attribute.

B<RESULT>

When a  file was  created both function  return 0 for  failure, or  1 for success.   Otherwise they
return a string reference (the compiled text).

B<EXAMPLES>

Functional interface:

    use Data::Rlist;            # imports WriteCSV

    WriteCSV($thing, "foo.dat");

    WriteCSV($thing, "foo.dat", { separator => '; ' }, [qw/GBKNR VBKNR EL LaD/]);

    WriteCSV($thing, \$target_string);

    $string_ref = WriteCSV($thing);

Object-oriented interface:

    $object = new Data::Rlist(-data => $thing, -output => "foo.dat",
                              -options => { separator => '; ' },
                              -columns => [qw/GBKNR VBKNR EL LaD LaD_V/]);

    $object->write_csv;         # Write $thing as CSV to foo.dat
    $object->write;             # Write $thing as Rlist to foo.dat

    $object->set(-output => \$target_string);

    $object->write_csv;         # Write $thing as CSV to $target_string

Please see F<L</read_csv>()> for more examples.

=head3 F<write_string(DATA[, OPTIONS])>

Stringify any Perl data  DATA and return a reference to the  string.  Works like F<L</write>()> but
always compiles  to a new  string to which  it returns a  reference.  Consequently, when  called as
method this function  does not use the  F<-output> and F<-options> attributes, and  the default for
OPTIONS is L<C<"string">|/Predefined Options>.

=head3 F<make_string(DATA[, OPTIONS])>

Stringify   any   Perl   dat   DATA   and   return  the   string   value.    OPTIONS   default   to
L<C<"default">|/Predefined Options>.  For example,

    print "\n\$thing dumped: ", Data::Rlist::make_string($thing);

    $self = new Data::Rlist(-data => $thing);

    print "\nsame \$thing dumped: ", $self->make_string;

=head3 F<keelhaul(DATA[, OPTIONS])>

Do a  deep copy of DATA  according to L<OPTIONS|/Compile Options>.   DATA is any Perl  data or some
F<Data::Rlist>  object.   F<keelhaul()> first  compiles  arbitary Perl  data  to  Rlist text,  then
restores the data from exactly this text.  By "keelhauling data" one can therefore

- adjust the accuracy of numbers, 

- break circular-references and 

- drop F<\*foo{THING}>s.

Such a functionality  is useful when DATA had been  hatched by some other code,  and you don't know
whether it is hierachical, or if typeglob-refs  nist inside.  You may then simply F<keelhaul> it to
clean it  from its (wild) past.  Multiple  data sets can so  be brought to the  same, common basis.
For example, to bring all numbers in

    $thing = { foo => [ [ .00057260 ], -1.6804e-4 ] };

to a certain accuracy, use

    $deep_copy_of_thing = Data::Rlist::keelhaul($thing, { precision => 4 });

All number scalars in F<$thing> are are  rounded to 4 decimal places, so they're finally comparable
as floating-point numbers.  To F<$deep_copy_of_thing> is assigned the hash-reference

    { foo => [ [ 0.0006 ], -0.0002 ] }

Likewise one can convert all floats to integers:

    $make_integers = new Data::Rlist(-data => $thing, -options => { precision => 0 });

    $thing_without_floats = $make_integers->keelhaul;

When F<keelhaul()> is called in an array context it also returns the text from which the copy had
been built.  For example,

    $deep_copy = Data::Rlist::keelhaul($thing);

    ($deep_copy, $rlist_text) = Data::Rlist::keelhaul($thing);

    $deep_copy = new Data::Rlist(-data => $thing)->keelhaul;

It is then guarantee that the following statement never throws:

    die if deep_compare($deep_copy, ReadData(\$rlist_text));

B<EFFECTS>

F<keelhaul()> won't throw F<die> nor return an error, but be prepared for the following effects:

=over

=item *

F<ARRAY>, F<HASH>, F<SCALAR> and F<REF> references were compiled, whether blessed or not.  (Since
compiling does not store type information, F<keelhaul()> will turn blessed references into barbars
again.)

=item *

F<IO>, F<GLOB> and F<FORMAT> references have been converted into strings.

=item *

Depending on the compile options, F<CODE> references were invoked, deparsed back into their function
bodies, or dropped.

=item *

Depending on the compile options floats have been rounded, or have been converted to integers.

=item *

F<undef>'d array elements had been converted into the default scalar value C<"">.

=item *

Anything deeper than F<$Data::Rlist::MaxDepth> had been thrown away.  However, this only would
happen when F<$Data::Rlist::MaxDepth> is not 0.

=item *

When the data contains objects, no special methods are triggered to "freeze" and "thaw" the
objects.

=back

See also F<L</compile>()>, F<L</equal()>> and F<L</deep_compare>()>

=head2 Static Interface

=head3 F<predefined_options([PREDEF-NAME])>

Get the hash-ref F<$Data::Rlist::PredefinedOptions{PREDEF-NAME}>.  PREDEF-NAME defaults to
L<C<"default">|/Predefined Options> (i.e., the options for writing files).

=head3 F<complete_options([OPTIONS[, BASIC-OPTIONS]])>

Completes  OPTIONS  with  BASIC-OPTIONS:  all  pairs   not  already  in  OPTIONS  are  copied  from
BASIC-OPTIONS.   Both  arguments  define  hashes  or  some  L<predefined  options  name|/Predefined
Options>, and default to L<C<"default">|/Predefined Options>.   This function returns a new hash of
L<compile options|/Compile  Options>.  (Even when OPTIONS  defines a hash  it is copied into  a new
one.)  For example,

    $options = complete_options({ precision => 0 }, 'squeezed')

merges the predefined options for L<C<"squeezed">|/Predefined Options> text (no whitespace at all,
no here-docs, numbers rounded) with a numeric precision of 0.  This converts all floats to
integers.  The following call completes F<$them> by some other hash:

    $options = complete_options($them, { delimiter => '\s+' })

That  is, it  copies C<"delimiter">  unless such  a  key already  exists into  F<$them>. Note  that
F<$them> itself isn't modified.

=cut

sub predefined_options($) {
    my $name = shift || 'default';
    carp "\nunknown compile-options '$name'" unless exists $PredefinedOptions{$name};
    $PredefinedOptions{$name};
}

sub complete_options(;$$);
sub complete_options(;$$)
{
    my($opts, $base) = (shift||'default', shift||'default');
    my $using_default = ($base eq 'default');
    $opts = predefined_options($opts) unless ref $opts;
    $base = predefined_options($base) unless ref $base;

    # Make a new hash, copy all keys not already in $opts from $base.
    $opts = { %$opts };
    $opts->{_base} = ref($base) ? 'some hash' : $base;
    while (my($k, $v) = each %$base) {
        $opts->{$k} = $v unless exists $opts->{$k}
    }

    # Finally complete $opts with "default" and return the new hash.
    $opts = complete_options($opts) unless $using_default;
    $opts
}

sub write($;$$$);
sub write($;$$$)
{
    my($data, $output) = (shift, shift);
    my($options, $header) = @_;
    local $| = 1 if $DEBUG;

    if (ref($data) eq __PACKAGE__) {
        # $data was created by Data::Rlist->new.
        $data->dock
        (sub {
             $output ||= $data->get('-output');
             $options ||= $data->get('-options');
             $header ||= $data->get('-header');
             Data::Rlist::write($data->get('-data'), $output, $options, $header);
         });
    } else {
        # $data is any Perl data or undef.  Reset package globals, validate $options, then compile
        # $data.

        my $to_string = ref $output || not defined $output;
        my($result, $optname, $fast, $perl);
        $options ||= ($to_string ? 'string' : 'fast');
        unless (ref $options) {
            $fast = 1 if $options eq 'fast';
            $perl = 1 if $options eq 'perl';
            $optname = "'$options'";
            $options = predefined_options($options) unless $fast || $perl;
        } else {
            $optname = "custom, based on '${\($options->{_base} || 'default')}'";
        }
        unless ($fast || $perl) {
            $options->{auto_quote} = 1 unless defined $options->{auto_quote};
        }

        unless ($to_string) {
            # Compile $data into a file named $output.
            #
            # Create new file and exclusively lock it. It is guaranteed that no other process will
            # be able to run flock(FH,2) on the same file while you hold the lock. (Because the OS
            # suspends and blocks other processes.)

            confess $output if not defined $output or ref $output; # or not_valid_pathname($output)
            my($to_stdout, $fh) = $output eq '-';
            if ($to_stdout) {
                open($fh, ">$output") or confess("\nERROR: $!");
            } else {
                (open($fh, ">$output") and flock($fh, 2)) or
                confess("\nERROR: $output: can't create and lock Rlist-file: $!");
            }

            # Build file header.  Compile $data to file $fh.  Then returns undef.  The eval traps
            # die exceptions.

            my $host = eval { use Sys::Hostname; hostname; } || 'some unknown machine';
            my $uid = getlogin || getpwuid($<);
            my $tm = localtime;
            my $prec; $prec = $options->{precision} if ref $options and defined $options->{precision};
			my $eol = $/; $eol = $options->{eol_space} if ref $options and defined $options->{eol_space};
            my @header = 
            map { (length) ? "# $_\n" : "#\n" }
            (($to_stdout ? () : 
              ("-*-rlist-generic-*-", "", $output, "",
               "Created $tm on <$host> by user <$uid>.",
               "Random Lists (Rlist) file (see Data::Rlist on CPAN and <http://www.visualco.de>).")),
             ((defined $prec) ? 
              sprintf('Numerical precision: fixed-point, rounded to %d decimal places.', $prec) :
              sprintf('Numerical precision: floating-point.')),
             "Compile options: $optname.", 
             ($header ? ("", @$header) : ("")));
            print $fh @header, $eol;

            unless ($fast || $perl) {
                $result = 1 if compile($data, $options, $fh);
            } else {
                # Note that compile_fast() and compile_Perl() both return a reference to
                # $Data::Rlist::R.
                $result = 1;
                print $fh ${compile_fast($data)}.$eol if $fast;
                print $fh ${compile_Perl($data)}.$eol if $perl;
            } close $fh;
        } else {
            # Compile $data into string and return a reference to it.
            #
            # At this point $output has to be undef or a string-reference.  In case of the latter a
            # reference to the compiled Rlist is not only returned, but also its value is copied to
            # the string referred to by output.

            confess $output unless not defined $output or ref $output eq 'SCALAR';
            unless ($fast || $perl) {
                $result = compile($data, $options);
                $output = $result if ref $output;
            } else {
                $result = compile_fast($data) if $fast;
                $result = compile_Perl($data) if $perl;
                $$output = $$result if ref $output; # we have to copy, since $result refers to
                                                    # $Data::Rlist::R
            }
        } return $result;
    }
}

sub write_csv($;$$$$);
sub write_csv($;$$$$)
{
    my($data, $output) = (shift, shift);
    my($options, $columns, $header) = @_;
    return 0 unless defined $data;

    if (ref($data) eq __PACKAGE__) {
        # $data was created by Data::Rlist->new.
        $data->dock
        (sub {
             $output ||= $data->get('-output');
             $options ||= $data->get('-options');
             $columns ||= $data->get('-columns');
             $header ||= $data->get('-header');
             Data::Rlist::write_csv($data->get('-data'), $output, $options, $columns, $header);
         });
    } else {
        # $data is any Perl data or undef.  In case of undef returns 0.  When the file could not be
        # created, dies. Otherwise returns 1.
        #
        # Unless a value looks like a number the value is quote()d.  read_csv() uses split_quoted()
        # which keeps quotes and backslashes, then maybe_unquote()s each value.  Note that quoting
        # is generally necessary, because strings could also contain commas.

        $options = complete_options($options, 'default');
        my $to_string = ref $output || not defined $output;
        my($separator, $prec, $auto_quote) = map { $options->{$_} } qw/separator precision auto_quote/;
		my $eol = $/; $eol = $options->{eol_space} if ref $options and defined $options->{eol_space}; $eol ||= "\n";
        my $result = '';
        $auto_quote = 0 unless defined $auto_quote;
        $result.= join($separator, @$columns).$eol if $columns;
        $result.= join($eol, map {
            join($separator, map { is_number($_)
                                   ? (defined($prec) ? round($_, $prec) : $_)
                                   : ($auto_quote ? maybe_quote($_) : $_)
                               } @$_) } @$data).$eol if @$data;

        if ($to_string) {
            if (ref $output) {
                $$output = $result; return $output
            } else {
                return \$result;
            }
        } else {
            my($to_stdout, $fh) = ($output eq '-');
            local $| = 1 if $DEBUG;
            if ($to_stdout) {
                open($fh, ">$output") or confess("\nERROR: $!");
            } else {
                (open($fh, ">$output") and flock($fh, 2)) or
                confess("\nERROR: $output: can't create and lock CSV-file: $!");
            }
            # TODO: write $header
            print $fh $result;
            close $fh; 1
        }
    }
}

sub write_conf($;$$$$)
{
    my($data, $output, $options, $header) = @_;
    $options ||= $data->get('options') if ref($data) eq __PACKAGE__;
    my $have_sep = ref($options) && defined $options->{separator};
    $options = complete_options($options) unless ref $options;
    $options->{separator} = $DefaultConfSeparator unless $have_sep;
    return write_csv($data, $output, $options, $header);
}

sub write_string($;$) {
    my($data, $options) = (shift, shift||'string');
    my $strref;
    if (ref($data) eq __PACKAGE__) {
        # When $data was created by Data::Rlist->new defuses a possible -output attribute.  Passing
        # some \$str argument for OUTPUT to write() means to copy the compiled Rlist redundantly to
        # $str.

        my $out = $data->get('output');
        $data->set(-output => undef);
        $strref = Data::Rlist::write($data, undef, $options);
        $data->set(-output => $out);
    } else {
        $strref = Data::Rlist::write($data, undef, $options);
    } return $strref;
}

sub make_string($;$) {
    my($data, $options) = (shift, shift||'default');
    local $MaxDepth = $DefaultMaxDepth if $MaxDepth == 0;
    return ${Data::Rlist::write_string($data, $options)};
}

sub keelhaul($;$) {
    my($data, $options) = (shift, shift);
    carp 'Cannot keelhaul Perl data' if defined $options and $options eq 'perl'; # TODO: eval back
    $options ||= complete_options({ precision => undef }, 'squeezed');
    my $strref = Data::Rlist::write_string($data, $options);
    local $MaxDepth = $DefaultMaxDepth if $MaxDepth == 0;
    my $deep_copy = read_string($strref);
    return wantarray ? ($deep_copy, $strref) : $deep_copy;
}

=head2 Implementation

=head3 F<open_input(INPUT[, FILTER, FILTER-ARGS])>

=head3 F<close_input()>

Open/close  Rlist text  file or  string INPUT  for parsing.  Used internally  by  F<L</read>()> and
F<L</read_csv>()>.

B<PREPROCESSING>

The function  can preprocess the INPUT  file using FILTER.  Use  the special value 1  to select the
default  C preprocessor  (F<gcc  -E -Wp,-C>).   FILTER-ARGS  is an  optional  string of  additional
command-line arguments to be appended to FILTER.  For example,

    my $foo = Data::Rlist::read("foo", 1, "-DEXTRA")

eventually does not parse F<foo>, but the output of the command

    gcc -E -Wp,-C -DEXTRA foo

Hence within F<foo> C-preprocessor-statements become possible

    {
    #ifdef EXTRA
    #include "extra.rlist"
    #endif

        123 = (1, 2, 3);
        foobar = {
            .
            .

B<SAFE CPP MODE>

This mode uses F<sed> and a  temporary file.  It is enabled by setting F<$Data::Rlist::SafeCppMode>
to 1  (the default is  0).  It  protects single-line F<#>-comments  when FILTER begins  with either
F<gcc>, F<g++> or  F<cpp>.  F<L</open_input>()> then additionally runs F<sed>  to convert all input
lines beginning  with whitespace plus the  F<#> character.  Only the  following F<cpp>-commands are
excluded, and only when they appear in column 1:

- F<#include> and F<#pragma>

- F<#define> and F<#undef>

- F<#if>, F<#ifdef>, F<#else> and F<#endif>.

For  all other  lines F<sed>  converts F<#>  into  F<##>.  This  prevents the  C preprocessor  from
evaluating them.  Because  of Perl's limited F<open()> function, which isn't  able to dissolve long
pipes, the invocation  of F<sed> requires a temporary  file.  The temporary file is  created in the
same directory as  the input file.  When you  only use F<//> and F</* */>  comments, however, "Safe
CPP Mode" is not required.

=cut

sub open_input($;$$)
{
    my($input, $fcmd, $fcmdargs) = @_;
    my($rls, $filename);
    my $rtp = reftype $input;

    carp "\n${\((caller(0))[3])}: filename or scalar-ref required as INPUT" if defined $rtp && $rtp ne 'SCALAR';
    carp "\n${\((caller(0))[3])}: package locked" if $Readstruct;
    $Readstruct = $ReadFh = undef;
    local $| = 1 if $DEBUG;

    if (defined $input) {
        $Readstruct = { };
        unless (ref $input) {
            # Input is a filename, not a string reference.
            $Readstruct->{filename} = $input;

            unless ($fcmd) {
                # Normal mode. No filter-command for input file.  The file is read directly
                # (unfiltered), and the input file will be locked.

                unless (open($Readstruct->{fh}, "<$input") && flock($Readstruct->{fh}, 1)) {
                    # This may not be the end of this script! The caller could have trapped the die
                    # exception in an eval; hence we've to be tidy.

                    $Readstruct = undef;
                    pr1nt('ERROR', "input file '$input'", $!);
                }
            } else {
                $fcmd = "gcc -E -Wp,-C -x c++" if $fcmd == 1;
                $fcmd = "$fcmd $fcmdargs" if $fcmdargs;

                if ($SafeCppMode) {
                    if ($fcmd =~ /^(gcc|g\+\+|cpp)/i) {
                        # Safe cpp mode. Filter input with sed:
                        #
						# (1) Because known #-commands must start at column 1 we first escape all
						#     indented '#'s into '##'s:
						#			"(^ +)#" -> '$1\#'
						#
                        # (2) Next we prefix the known commands with a blank, e.g.
                        #			"#if 0" -> " #if 0"
                        #
                        # (3) Finally we escape all unknown #-commands at column 1:
						#			"^#" -> "\#"
						#
						# The lexln() function then converts escape #s in the preprocessed file
						# back:
						#
						#			"(^ *)\#" -> "$1#"
                        #
						# The above regexes are in perl (not sed) syntax.  This output is then
                        # preprocessed.  Since the builtin open() does not support true pipes a
                        # temporary file receives the output of sed.

						my($sedfh, $tmpfh);
						open($sedfh,
							 "sed '".join('; ', ("s/^\\([ \t][ \t]*\\)#/\\1\\\\#/", # many seds don't recognize \t; hence insert literally
												 "s/^#\\(include\\|pragma\\|if\\|ifdef\\|else\\|endif\\|define\\|undef\\)/ #\\1/",
												 "s/^#/\\\\#/")).";' <$input 2>nul |") || die "\nERROR: input file '$fcmd': $!";
						my($tmpinput, $i) = (undef, 0);
						do { $tmpinput = $input.'.tmp'.$i++ } while -e $tmpinput;
						$Readstruct->{tmpfile} = $input = $tmpinput; # will be removed in close_input()
						open ($tmpfh, ">$input") || die "\nERROR: temporary file '$input': $!";
						print $tmpfh readline($sedfh);
						close $tmpfh;
						close $sedfh;
                    }
                }

                # Open the file $input for preprocessing.

                unless (open($Readstruct->{fh}, "$fcmd $input 2>nul |")) {
                    $Readstruct = undef;
                    pr1nt('ERROR', "preprocessed input '$fcmd $input': $!");
                }
            }

            if (defined $Readstruct) {
                $ReadFh = $Readstruct->{fh};
                $LnArray = undef;
				$Ln = '';
            }
        } else {
            # Input is a string reference.  Split it into lines at LF or CR+LF. Note that it isn't
            # necessary for the string to have newlines.

            carp "cannot preprocess strings" if $fcmd;

            # Don't use split_quoted because the input string is arbitary.

            $LnArray = [ split /\r*\n/, $$input ];
            $Ln = '';
        }
    }
    $Readstruct
}

sub close_input()
{
    if ($Readstruct->{fh}) {
        close($Readstruct->{fh});
    }
    if ($Readstruct->{tmpfile}) {
		unlink($Readstruct->{tmpfile}) ||
		croak "\nERROR: could not temporary file '$Readstruct->{tmpfile}': $!";
    }
    $LnArray = $Ln = $Readstruct = undef
}

=head3 F<lex()>

Lexical scanner.  Called  by F<L</parse>()> to split the current line  into tokens.  F<lex()> reads
F<#>  or  F<//>  single-line-comment  and  F</* */>  multi-line-comment  as  regular  white-spaces.
Otherwise it returns tokens according to the following table:

    RESULT      MEANING
    ------      -------
    '{' '}'     Punctuation
    '(' ')'     Punctuation
    ','         Operator
    ';'         Punctuation
    '='         Operator
    'v'         Constant value as number, string, list or hash
    '??'        Error
    undef       EOF

F<lex()> appends all here-doc-lines with a newline character. For example,

        <<test1
        a
        b
        test1

is effectively read as C<"a\nb\n">, which is the same value as the equivalent here-doc in Perl has.
So, not all  strings can be encoded as a  here-doc.  For example, it might not  be quite obvious to
many programmers that C<"foo\nbar"> cannot be expressed as here-doc.

=head3 F<lexln()>

Read the next line of text from the current input.  Return 0 if F<L</at_eof>()>, 1 otherwise.

=head3 F<at_eof()>

Return true if current input file/string is exhausted, false otherwise.

=head3 F<parse()>

Read Rlist language productions from current input.  This is a fast, non-recursive parser driven by
the  parser map  F<%Data::Rlist::Rules>,  and fed  by  F<L</lex>()>.  It  is  called internally  by
F<L</read>()>.

=cut

# Local variables of lex(). Lexical variables are initialized at compile time, hence they're
# available in INIT.

my $C1;
my $RELexNumber = qr/^($REFloatHere)/;	# number constant
my $RELexSymbol = qr/^($RESymbolHere)/; # symbolic name without quotes
my $RELexQuotedString = qr/^\"((?:\\[nrbftv\"\'\\]|\\[0-7]{3}|[^\"])*)\"/; # quoted string constant
my $RELexQuotedSymbol = qr/^"($RESymbolHere)"/; # symbolic name in quotes
my $RELexPunctuation = qr/^[$REPunctuationCharacter]/;

BEGIN {
	$REIsPunct[$_] = 0 foreach  0..255;
	$REIsPunct[ 61] = 1;			# =
	$REIsPunct[ 44] = 1;			# ,
	$REIsPunct[ 59] = 1;			# ;
	$REIsPunct[123] = 1;			# {
	$REIsPunct[125] = 1;			# }
	$REIsPunct[ 40] = 1;			# (
	$REIsPunct[ 41] = 1;			# )

	$REIsDigit[$_] = 0 foreach  0..255;
	$REIsDigit[$_] = 1 foreach 48.. 57;
	$REIsDigit[43] = $REIsDigit[45] = $REIsDigit[46] = 1;
}

sub lex()
{
    # First reduce leading whitespace and empty lines. Set $C1 to the ASCII code of the first
    # character in the current line $Ln.
	#
	# The Perl \s regex matches  [ \t\n\r\f], but
	#	($C1 <= 32 && ($C1 == 32 || $C1 == 9 || $C1 == 10 || $C1 == 13 || $C1 == 12))
	# is more efficient.  However, to make it even faster we use simply
	#	($C1 <= 32)

	unless (defined $Ln) {
		return undef unless lexln(); # fetch next $Ln or stop
	}
    NEXTC1:
	unless ($C1 = ord($Ln)) { # ord returns 0 on empty strings
		return undef unless lexln();
		goto NEXTC1;
	}
	if ($C1 <= 32) {
		$Ln =~ s/^\s+//o;
		goto NEXTC1 unless $C1 = ord($Ln);
	}

	# Puncutators = , ; { } ( )

	#if ($Ln =~ $RELexPunctuation) {
	#if ($C1 == 61 || $C1 == 44 || $C1 == 59 || $C1 == 123 || $C1 == 125 || $C1 == 40 || $C1 == 41) {
	if ($REIsPunct[$C1]) {
		$Ln = substr($Ln, 1);
		return chr($C1);
	}

    # Number scalars. C language single/double-precision numbers.  Test if $C1 is a digit, '.', '-'
    # or '+'.

    #if (($C1 >= 48 && $C1 <= 57) || $C1 == 43 || $C1 == 45 || $C1 == 46) {
	if ($REIsDigit[$C1]) {
        if ($Ln =~ s/$RELexNumber//o) {
            push @VStk, $1;
            return 'v';
        } elsif (($C1 == 45 || $C1 == 46) && $Ln =~ s/$RELexSymbol//o) {
            # Symbolic name (unquoted string) beginning with '-' or '.'.
            push @VStk, $1;
			return 'v';
        } else {
            return syntax_error(qq'unrecognized number "$Ln"');
        }
    }

    # String scalars, un/quoted, here-docs.

	if ($C1 == 34) {			# "
        # String scalar, quoted. Removes the quotes and unesacpes the strings (compile adds
        # quotes).

        #if (0) {
            # BUG: the regex engine of perl 5.8.7 (Cygwin) unconditionally exits when it tried to
            # match a large quoted string, e.g. >8000 characters.  perldb provides no hint
            # why. This problem once occurred during intensive testing of this package.

            #if (length($Ln) > 1000) {
                #print STDERR "string len=".length($Ln)." val = \n\n$Ln\n\n" if $DEBUG;

                # TODO: take a precautionary approach because of bug/misbehaviors in Perl's regex
                # engine now (see above). 
            #}
        #}

#         if ($Ln =~ s/$RELexQuotedSymbol//o) { # no escape sequences
#             push @VStk, $1;
#             return 'v';
#         }

		if ($Ln =~ s/$RELexQuotedString//o) { # maybe has escape sequences
            push @VStk, unescape($1);
			return 'v';
        } else {
			# There was no closing '"' found on this line. To recover from this error (which is
			# hard) we simply continue to fetch lines until EOF, or $RELexQuotedString happens to
			# match.  Then we return '??' instead of 'v'.

			my $Lnprev;
			syntax_error("unterminated quoted string '$Ln'");
			while (1) {
				$Lnprev = $Ln;
				unless (lexln()) {
					syntax_error("EOF in quoted string"); last;
				}
				$Ln = $Lnprev.$Ln;
				last if $Ln =~ s/$RELexQuotedString//o;
			} return '??';
		}
    } elsif ($C1 == 60) {		# <<HERE
        if ($Ln =~ s/<<([_\w]+)//io) {
            # Fetch lines until $tok appears at top of a line.  Then continues at $rest of original
            # line. If not EOF the next call to lexln() will return the next line after the line
            # that had closed the here-doc.

            my($tok, $rest, @ln, $ok) = ($1, $Ln);
            my $nanoscript = ($tok eq $DefaultNanoscriptToken);
            while ($ok = lexln()) {
                if ($Ln =~ /^$tok\s*$/m) {
                    $Ln = $rest; last;
                } else {
                    push @ln, unescape($Ln)
                }
            }
            unless ($ok) {
                confess unless at_eof();
				return syntax_error(qq(EOF while reading here-document '$tok'));
            } else {
                push @VStk, join("\n", @ln)."\n"; # add newline to all lines
                return $nanoscript ? 'n' : 'v';
            }
        }
    }

    # Jump over comments. '//' or '#' single-line-comment, '/*' multi-line-comment.

    if ($C1 == 35) {            # '#'
        $Ln = ''; goto NEXTC1;
    } elsif ($C1 == 47) {       # '/'
        if ($Ln =~ /^\/[\*\/]/o) {
            goto NEXTC1 if $Ln =~ s/^\/\*.*\*\/\s*//x;
            if ($Ln =~ /^\/\//o) {
                $Ln = ''; goto NEXTC1;
            }
            while (lexln()) {
                if ($Ln =~ /\*\/(.*)/) {
                    $Ln = $1; goto NEXTC1;
                }
            } return syntax_error(qq(unterminated comment));
        }
    }

	# Must be a symbolic name (unquoted string). Names are printable and hence have no \NNN
	# sequences.  (Finally applies a regex.)

    if ($Ln =~ s/$RELexSymbol//o) {
        push @VStk, $1;
        return 'v';
	}

    # Unrecognized character, e.g. '*', single '<', '\''.

	die "\n".syntax_error(qq(unrecognized character-code $C1).' '.chr($C1));
}

sub at_eof() {
    if ($ReadFh) {
        return eof($ReadFh);
    } elsif (defined $LnArray && $#$LnArray != -1) {
        return 0
    } else {
        return 1                # $LnArray undef'd or empty
    }
}

sub lexln() {
	# Called from lex() to parse Rlist files, and from read_csv().

	if ($ReadFh && !eof($ReadFh)) {	# eof(undef) and eof(0) are 1
		$Ln = readline($ReadFh); chomp $Ln;	# strips $/
		$Ln =~ s/^([ \t]*)\\#/$1#/o if $SafeCppMode;
		#print "$Ln\n";
		return 1;
    } elsif (defined $LnArray && $#$LnArray != -1) {
		# Read from string.
		$Ln = shift @$LnArray;
		return 1;
    }
	$Ln = undef;
	return 0;
}

sub parse()
{
    my($q, $t, $m, $r, $l) = ('');
    $Warnings = $Errors = $MissingInput = $Broken = 0;
    @Messages = @VStk = @NStk = ();

    while (defined($t = lex())) {
        # Push new token to the queue, then reduce as many rules as possible from the tail of the
        # queue. First tries to match long rules. After reducing the queue as far as possible fetch
        # more tokens towards EOF.
		#
		# Note that the constants 2 and 4 are the min./max. lengths of rules in %Rules. When $l
		# (the current length of $m) is <2 no rule can be matched.

		#if (!$DEBUG) {
		if (1) {
			$q .= $t;
			while (($l = length($q)) >= 2) {
				if ($r = $Rules{substr($q, -4)}) {
					substr($q, -4) = $r->();
				} elsif ($r = $Rules{substr($q, -3)}) {
					substr($q, -3) = $r->();
				} elsif ($r = $Rules{substr($q, -2)}) {
					substr($q, -2) = $r->();
				} else { last }	  # fetch another token
			}					  # match another rule
		} else {
			# The above loop is ca. 10% faster than the second, so this one is disabled (however,
			# it is working).  The if(1/0) blocks are expected to be neutralized by the
			# byte-compiler.

			$l = length($q .= $t);
			while ($l >= 2) {
				$l = 4 if $l > 4;
				$m = substr($q, -$l);

				while (1) {
					# TODO: last if $m begins with [=,;})]
					if ($Rules{$m}) {
						# Can reduce a rule $m.
						printf STDERR "%20s\treducing  $m\n", $q if $DEBUG;
						substr($q, -$l) = $Rules{$m}->();
						$l = length $q; last;
					} else {
						# $m is not a matching rule.  Cut the first character from $m and try
						# matching it.
						#
						# Quickly removing the first character from a string is surprisingly
						# hard. All of the following work:
						#
						#   $m = unpack('x1A'.$l, $m)
						#   $m = substr($m, 1)		# fastest
						#   substr($m, 0, 1) = ''

						printf STDERR "%20s\tno rule   $m\n", $q if $DEBUG && $l > 1;
						last if --$l < 2;
						$m = substr($m, 1);
					}
				} last if $Errors; # stop if an error occured
			}
		}
    }

	# Parser finished.
    if ($Errors) {
        return undef;
    } else {
        # EOF reached, which means lex() had returned undef. The token queue has now been reduced
        # to one token and @VStk only contains its value. The token 'h' (hash) or 'l'
        # (list). Because of the parser map nature it could also be 'v' (value), in which case it
        # shall decay into a hash or list.

        print STDERR qq'Data::Rlist::parse() reached EOF with "$q"\n' if $DEBUG;

        if (@VStk == 0) {
            # Empty input or non-existing file.
            croak STDERR "unexpected, supernumeray tokens after parsing:\n\t$q\n" if $DEBUG && $q;
            $MissingInput = 1; return undef;
        } else {
            if (@VStk > 1) {
                pr1nt('ERROR', qq'broken input', qq'expected "l" (list) or "h" (hash), not "$q"');
                my @overproduced = map { ref($_) ? $_ : Data::Rlist::quote($_) } @VStk;
                for (my $i = 0; $i <= $#overproduced; ++$i) {
                    warning(sprintf("cancelling overbilled value [%u] %s", $i, $overproduced[$i]));
                }
                print STDERR qq'Data::Rlist::parse() returns undef\n' if $DEBUG;
                return undef;
            } elsif (not defined $VStk[0]) {
                confess         # dto.
            } elsif ($q eq 'v') {
                my $rtp = reftype $VStk[0]; # result type
                unless (defined $rtp) {
                    $VStk[0] = { $VStk[0] => undef } # not a reference - the input is just one scalar
                } elsif ($rtp !~ /(?:HASH|ARRAY)/) {
                    confess quote($VStk[0]) # shall be an array/hash-reference
                }
            }
        }

        print STDERR "Data::Rlist::parse() returns $VStk[0]\n" if $DEBUG;
        return pop @VStk;
    }
}

=head3 F<compile(DATA[, OPTIONS, FH])>

Build Rlist  text from any Perl data  DATA.  When FH is  defined compile directly to  this file and
return 1.   Otherwise (FH is F<undef>) build  a string and return  a reference to it.   This is the
compilation   function    called   when   the    OPTIONS   argument   passed    to   F<L</write>()>
orF<L</write_string>()> is  not omitted, and  is not C<"fast">  or C<"perl">.  DATA is  compiled as
follows:

=over

=item *

Reference-types F<SCALAR>, F<HASH>, F<ARRAY> and F<REF> are compiled into text, whether blessed or
not.

=item *

Reference-types F<CODE> are compiled depending on the L<C<"code_refs">|/Compile Options> setting in
OPTIONS.

=item *

Reference-types F<GLOB> (L<typeglob-refs|/Background: A Short Story of Typeglobs>), F<IO> and
F<FORMAT> (file- and directory handles) cannot be dissolved, and are compiled into the strings
C<"?GLOB?">, C<"?IO?"> and C<"?FORMAT?">.

=item *

F<undef>'d values in arrays are compiled into the default Rlist C<"">.

=back

=head3 F<compile_fast(DATA)>

Build Rlist  text from any Perl data  DATA.  Do this as  fast as actually possible  with pure Perl.
Note that this is the default compilation function called when OPTIONS are omitted, or C<"fast"> is
passed (see F<L</write>()> and F<L</write_string>()>). DATA is compiled as follows:

=over

=item *

Reference-types F<SCALAR>, F<HASH>, F<ARRAY> and F<REF> are compiled into text, whether blessed or
not.

=item *

F<CODE>, F<GLOB>, F<IO> and F<FORMAT> are compiled into the strings C<"?CODE?">, C<"?IO?">,
C<"?GLOB?"> and C<"?FORMAT?">.  

=item *

F<undef>'d values in arrays are compiled into the default Rlist C<"">.

=back

The  main   difference  to  F<L</compile>()>   is  that  F<compile_fast()>  considers   no  compile
options. Thus it cannot call code,  implicitly round numbers, and cannot detect recursively-defined
data.  Also F<compile_fast()> returns a reference to the compiled string, which is a reference to a
unique package variable.  Subsequent calls to F<compile_fast()> reassign this variable.  Because of
this behaviors, F<compile_fast()> is very... fast!

=head3 F<compile_Perl(DATA)>

Like F<L</compile_fast>()>, but do  not compile Rlist text - compile DATA  into Perl syntax. It can
then  be F<eval>'d.   This renders  more compact,  and more  exact output  as  L<Data::Dumper>. For
example, only strings are  quoted.  To enable this compilation function you  must pass C<"perl"> to
F<L</write>()> and F<L</write_string>()>, as the OPTIONS argument.

=cut

our($Datatype, $K, $V);
our($Outline_data, $Outline_hashes, $Code_refs, $Here_docs, $Auto_quote, $Precision);
our($Eol_space, $Paren_space, $Bol_tabs, $Comma_punct, $Semicolon_punct, $Assign_punct);

sub compile($;$$)
{
    my($data, $result) = shift;
    my $options = complete_options(shift);

    local($Fh, $Depth, $Broken) = (shift, -1, 0);
    local $RoundScientific = 1 if $options->{scientific};
    local($Eol_space, $Paren_space, $Bol_tabs, 
          $Comma_punct, $Semicolon_punct, $Assign_punct) = map { $options->{$_} }
          qw/eol_space paren_space bol_tabs 
             comma_punct semicolon_punct assign_punct/;

    local($Outline_data, $Outline_hashes,
          $Code_refs, $Here_docs, $Auto_quote, $Precision) = map { $options->{$_} }
          qw/outline_data outline_hashes
             code_refs here_docs auto_quote precision/;

	$Eol_space = $/ unless defined $Eol_space;

    return compile1($data) unless $Fh; # return string-reference
    return compile2($data);     # return 1
}

sub comptab($) {
    return '' if $Bol_tabs == 0; # no indentation
    return chr(9) x ($Bol_tabs * ($Depth + $_[0])); # use physical TABs
}

sub compval($) {
    # Compile a scalar value (number or string, but not a reference).
    #
    # TODO: to gain more speed, in compile create a specialized sub depending on globals
    # $Precision, $Here_docs.
    #
    my $v = shift;
    if (defined $v) {
        if ($v !~ $REValue) {
            # Not an identifier, number or quoted string.  Hence $v will be quoted, and maybe as
            # here-doc.
            if ($Here_docs) {
                if ($v =~ /\n.*\n\z/os) {
                    # Here-docs enabled and $v qualifies.  Note that we want to write only strings
                    # with at least two LFs as here-docs (although a final LF would be sufficient).
                    # Now find a token that doesn't interfere with the text: try "___", "HERE",
                    # "HERE0", "HERE1" etc.

                    my @ln = split /\n/, $v;
                    my $tok = '___';
                    while (1) {
                        last unless grep { /^$tok/ } @ln;
                        if ($tok =~ /\d\z/) {
                            $tok++
                        } else {
                            $tok = $tok !~ 'HERE' ? 'HERE' : 'HERE0'
                        }
                    } $v = join('', map { "$_\n" } ("<<$tok", (map { escape($_) } @ln), $tok));
                } else {
                    $v = quote($v)
                }
            } else {
                $v = quote($v)
            }
        } elsif (ord($v) != 34) {
            # Not already quoted.  Either $v is a number or a symbolic name.
            if ($Auto_quote) {
                if ($v =~ $REFloat) {
                    $v = round($v, $Precision) if defined $Precision;
                } else {
                    die $v unless $v =~ $RESymbol;
                    $v = qq("$v");
                }
            } elsif (defined $Precision) {
                $v = round($v, $Precision) if $v =~ $REFloat;
            }
        }
    } $v
}

sub compile1($);
sub compile1($)
{
    # Compile Perl data structure $data into some Rlist and return a string reference.

    my $data = shift;
    my($r, $inl, $k, $v);

    if (ref $data) {
        $Datatype = ord reftype $data;
        $Depth++;
        if ($MaxDepth >= 1 && $MaxDepth < $Depth) {
            pr1nt('ERROR', "compile1() broken in deep $data (max-depth = $MaxDepth)") unless $Broken++;
            $r = DEFAULT_VALUE
        } elsif ($Datatype == 65) { # 65 => 'A' => 'ARRAY'
            my $cnt = @$data;
            unless ($cnt) {
                $r = '('.$Paren_space.')';
            } elsif ($Outline_data > 0 && $Outline_data <= $cnt) {
                # List has more than $Outline_data number of configured elements; print each
                # element on a separate line.

                my($pref0, $pref) = (comptab(0), comptab(1));
                $r.= $Eol_space.$pref0.'('.$Eol_space.$pref;

                # BUG: for some strange reason it destroys $data if assigning the result of the
                # recursive compile1() call to $v again.  Perl 5.8.6,
                # cygwin-thread-multi-64int. Solution: assign temporarily to $w.

                my $w;
                foreach $v (@$data) {
                    $w = ${compile1($v)};
                    $r.= $Comma_punct.$Eol_space.$pref if $inl; $inl = 1;
                    $r.= $w;
                }
                $r.= $Eol_space.$pref0.')';
            } else {
                # Print all entries to one line.

                my $w;
                $r.= '('.$Paren_space;
                foreach $v (@$data) {
                    $w = ${compile1($v)};
                    $r.= $Comma_punct if $inl; $inl = 1;
                    $r.= $w;
                }
                $r.= $Paren_space if $inl;
                $r.= ')';
            }
        } elsif ($Datatype == 72) { # 72 => 'H' => 'HASH'
            my @keys = sort keys %$data;
            unless (@keys) {
                $r = '{'.$Paren_space.'}';
            } else {
                my $manykeys = $Outline_data && @keys;
                my($pref0, $pref) = (comptab(0), comptab(1));
                foreach $k (@keys) {
                    $v = $data->{$k};
                    unless ($inl) { # prepare first pair
                        $r.= $Eol_space.$pref0 if $Outline_hashes && $manykeys;
                        $r.= '{'.$Paren_space;
                        $r.= $Eol_space if $manykeys; $inl = 1;
                    }
                    $k = $pref.(($k !~ $REValue) ? quote($k) : $k);
                    unless (defined($v)) {
                        $r.= $k.$Semicolon_punct.$Eol_space; # value is undef
                    } else {
                        $v = ${compile1($v)};
                        $r.= $k.$Assign_punct.$v.$Semicolon_punct.$Eol_space;
                    }
                }
                $r.= $pref0 if $manykeys;
                $r.= '}';
                $r.= $Eol_space unless $Depth;
            }
        } elsif ($Datatype == 82) { # 82 => 'R' => 'REF'
            $r.= ${compile1($$data)}
        } elsif ($Datatype == 83) { # 83 => 'S' => 'SCALAR'
            $r.= compval($$data);
        } elsif ($Datatype == 67) { # 67 => 'C' => 'CODE'
            $r.= $Code_refs ? ${compile1($data->())} :  '"?CODE?"'
        } else {                # other reference: 'IO', 'GLOB' or 'FORMAT'
            $r.= compval('?'.reftype($data).'?')
        }
        $Depth--;
    } elsif (defined $data) {   # $data is some scalar (not a ref)
        $r = compval($data);
    } else {                    # $data is undefined
        $r = DEFAULT_VALUE
    } \$r;
}

sub compile2($);
sub compile2($)
{
    # Compile Perl data structure $data into some Rlist and directly print into file handle $Fh (do
    # not compile a big string such as compile1() does).
    #
    # WARNING: this shall be merely a copy of the compile1() code.

    my $data = shift;
    my($inl, $k, $v);

    if (ref $data) {
        $Datatype = ord reftype $data;
        $Depth++;
        if ($MaxDepth >= 1 && $MaxDepth < $Depth) {
            pr1nt('ERROR', "compile2() broken in deep $data (depth = $Depth, max-depth = $MaxDepth)") unless $Broken++;
            print $Fh "\n", DEFAULT_VALUE;
        } elsif ($Datatype == 65) { # 65 => 'A' => 'ARRAY'
            my $cnt = 1 + $#$data;
            unless ($cnt) {
                print $Fh '('.$Paren_space.')';
            } elsif ($Outline_data > 0 && $Outline_data <= $cnt) {
                # List has more than the number of configured elements; print each element on a
                # separate line.

                my($pref0, $pref) = (comptab(0), comptab(1));
                print $Fh $Eol_space.$pref0.'('.$Eol_space.$pref;
                foreach $v (@$data) {
                    print $Fh $Comma_punct.$Eol_space.$pref if $inl; $inl = 1;
                    compile2($v);
                }
                print $Fh $Eol_space.$pref0.')';
                print $Fh $Eol_space unless $Depth;
            } else {
                # Print all entries to one line.
                print $Fh '('.$Paren_space;
                foreach $v (@$data) {
                    print $Fh $Comma_punct if $inl; $inl = 1;
                    compile2($v);
                }
                print $Fh $Paren_space if $inl;
                print $Fh ')';
            }
        } elsif ($Datatype == 72) { # 72 => 'H' => 'HASH'
            my @keys = sort keys %$data;
            unless( @keys ) {
                print $Fh '{'.$Paren_space.'}';
            } else {
                my $manykeys = $Outline_data && @keys;
                my($pref0, $pref) = (comptab(0), comptab(1));
                foreach $k (@keys) {
                    $v = $data->{$k};
                    unless ($inl) {
                        print $Fh $Eol_space.$pref0 if $Outline_hashes && $manykeys;
                        print $Fh '{'.$Paren_space;
                        print $Fh $Eol_space if $manykeys; $inl = 1;
                    }
                    $k = $pref.(($k !~ $REValue) ? quote($k) : $k);
                    unless (defined($v)) {
                        print $Fh $k.$Semicolon_punct.$Eol_space; # value is undef
                    } else {
                        print $Fh $k.$Assign_punct;
                        compile2($v);
                        print $Fh $Semicolon_punct.$Eol_space;
                    }
                }
                print $Fh $pref0 if $manykeys;
                print $Fh '}';
                print $Fh $Eol_space unless $Depth;
            }
        } elsif ($Datatype == 82) { # 82 => 'R' => 'REF'
            compile2($$data)
        } elsif ($Datatype == 83) { # 83 => 'S' => 'SCALAR'
            print $Fh compval($$data);
        } elsif ($Datatype == 67) { # 67 => 'C' => 'CODE'
            if ($Code_refs) {
                compile2($data->())
            } else {
                print $Fh '"?CODE?"'
            }
        } else {                # other reference: 'IO', 'GLOB' or 'FORMAT'
            print $Fh compval('?'.reftype($data).'?')
        }
        $Depth--;
    } elsif (defined $data) {   # $data is some scalar (not a ref)
        print $Fh compval($data);
    } else {                    # $data is undefined
        print $Fh DEFAULT_VALUE;
    } 1
}

sub compile_fast($)
{
    my $data = shift;
    $R = ''; $Depth = -1;       # reset result string
    compile_fast1($data); # return a string reference
    return \$R; # reference to the package-variable $Data::Rlist::R
}

sub compile_fast1($);
sub compile_fast1($)
{
    # Undefined values always are compiled into the default Rlist, the empty string.
    #
    # ord() returns 0 when reftype is undef, which it is for scalars.  For any reference, blessed
    # or not, reftype returns "HASH", "ARRAY", "CODE" or "SCALAR".  The $Datatype approach is
    # significantly faster than testing whether ref($data)=~'ARRAY' etc.

    my $data = $_[0];

    if (ref $data) {
        $Datatype = ord reftype $data;
        $Depth++;
        if ($Datatype == 65) {  # 65 => 'A' => 'ARRAY'
            # Open arrays in lines of their own, like we do also with hashes. The approach is fast
            # and compiles legible text.  Lists of lists (matrices) then look nice.

            if (@$data) {
                $R.= chr(10).(chr(9) x $Depth).'(';
                my $in = 0;
                foreach (@$data) {
                    unless ($in) { $in = 1 } else { $R.= ', ' }
                    if (defined) {
                        if (ref) {
                            compile_fast1($_)
                        } else {
                            $R.= $_ !~ $REValue ? quote($_): $_
                        }
                    } else { $R.= DEFAULT_VALUE }
                } $R.= ')';
            } else { $R .= '()' }
        } elsif ($Datatype == 72) {   # 72 => 'H' => 'HASH'
            if (%$data) {
                my $pref = chr(9) x $Depth;

                # Sorting is slightly slower than
                #       while (($K, $V) = each %$data)
                # but produces much nicer results.  Note also that calling is_random_text is
                # generally faster than to quote always.

                $R.= "{\n";
                foreach $K (sort keys %$data) {
                    $V = $data->{$K};
                    $K = quote($K) if $K !~ $REValue;
                    $R.= $pref.chr(9).$K;
                    if (defined $V) {
                        $R.= ' = ';
                        if (ref $V) {
                            compile_fast1($V);
                        } else {
                            $V = quote($V) if $V !~ $REValue;
                            $R.= $V;
                        }
                    } $R.= ";\n";
                } $R.= $pref.'}';
            } else {
                $R.= '{}'
            }
        } elsif ($Datatype == 82) { # 82 => 'R' => 'REF'
            compile_fast1($$data)
        } elsif ($Datatype == 83) { # 83 => 'S' => 'SCALAR'
            $R.= ($$data !~ $REValue) ? quote($$data) : $$data;
        } else {                # other reference: 'CODE', 'IO', 'GLOB' or 'FORMAT'
            $R.= '"?'.reftype($data).'?"'
        }
        $Depth--;
    } elsif (defined $data) {   # number or string
        $R.= ($data !~ $REValue) ? quote($data) : $data;
    } else {                    # undef
        $R.= DEFAULT_VALUE;
    }
}

sub compile_Perl($)
{
    my $data = shift;
    $R = ''; $Depth = -1;       # reset result string
    compile_Perl1($data);
    return \$R; # reference to the package-variable $Data::Rlist::R
}

sub compile_Perl1($);
sub compile_Perl1($)
{
    my $data = $_[0];
    sub __quote($) {
        my $s = shift;
        return $s if $s =~ /^["']/;
        return quote($s);
    }

    if (ref $data) {
        $Datatype = ord reftype $data;
        $Depth++;
        if ($Datatype == 65) {
            if (@$data) {
                $R.= chr(10).(chr(9) x $Depth).'[';
                my $in = 0;
                foreach (@$data) {
                    unless ($in) { $in = 1 } else { $R.= ', ' }
                    if (defined) {
                        if (ref) {
                            compile_Perl1($_)
                        } else {
                            $R.= is_number($_) ? $_ : __quote($_)
                        }
                    } else { $R.= DEFAULT_VALUE }
                } $R.= ']';
            } else { $R .= '[]' }
        } elsif ($Datatype == 72) {
            if (%$data) {
                my $pref = chr(9) x $Depth;
                $R.= "{\n";
                foreach $K (sort keys %$data) {
                    $V = $data->{$K};
                    $K = __quote($K) unless is_number($K);
                    $R.= $pref.chr(9).$K;
                    if (defined $V) {
                        $R.= ' => ';
                        if (ref $V) {
                            compile_Perl1($V);
                        } else {
                            $V = __quote($V) unless is_number($V);
                            $R.= $V;
                        }
                    } $R.= ",\n";
                } $R.= $pref.'}';
            } else {
                $R.= '{}'
            }
        } elsif ($Datatype == 82) {
            compile_Perl1($$data)
        } elsif ($Datatype == 83) {
            $R.= is_number($data) ? $$data : __quote($$data);
        } else {
            $R.= '"?'.reftype($data).'?"'
        }
        $Depth--;
    } elsif (defined $data) {   # number or string
        $R.= is_number($data) ? $data : __quote($data);
    } else {                    # undef
        $R.= DEFAULT_VALUE;
    }
}

=head2 Auxiliary Functions

The utility functions  in this section are generally useful when  handling stringified data.  These
functions are either very fast, or  smart, or both.  For example, F<L</quote>()>, F<L</unquote>()>,
F<L</escape>()>  and F<L</unescape>()>  internally use  precompiled regexes  and  precomputed ASCII
tables.  For this employing these functions should be faster then using own variants.

=head3 F<is_integer(SCALAR-REF)>

Returns  true when  a scalar  looks like  a positive  or negative  integer constant.   The function
applies the compiled regex F<$Data::Rlist::REInteger>.

=head3 F<is_number(SCALAR-REF)>

Test for strings that look like numbers. F<is_number()>  can be used to test whether a scalar looks
like  a  integer/float  constant  (numeric  literal).   The function  applies  the  compiled  regex
F<$Data::Rlist::REFloat>.  Note that it doesn't match

- leading or trailing whitespace,

- lexical conventions such as the C<"0b"> (binary), C<"0"> (octal), C<"0x"> (hex) prefix to denote a
  number-base other than decimal, and

- Perls' legible numbers, e.g. F<3.14_15_92>,

- the IEEE 754 notations of Infinite and NaN.

See also

    $ perldoc -q "whether a scalar is a number"

=head3 F<is_symbol(SCALAR-REF)>

Test for symbolic names.  F<is_symbol()> can be used to test whether a scalar looks like a symbolic
name.  Such strings need not to be quoted.  Rlist defines symbolic names as a superset of C
identifier names:

    [a-zA-Z_0-9]                    # C/C++ character set for identifiers
    [a-zA-Z_0-9\-/\~:\.@]           # Rlist character set for symbolic names

    [a-zA-Z_][a-zA-Z_0-9]*                  # match C/C++ identifier
    [a-zA-Z_\-/\~:@][a-zA-Z_0-9\-/\~:\.@]*  # match Rlist symbolic name

For  example,   scoped/structured  names   such  as  F<std::foo>,   F<msg.warnings>,  F<--verbose>,
F<calculation-info>  need not  be  quoted.  Note  that  F<is_symbol()> does  not  catch leading  or
trailing whitespace. Another restriction is that C<"."> cannot be used as first character, since it
could also begin a number.

=head3 F<is_value(SCALAR-REF)>

Returns true when the scalar is an integer, a number, a symbolic name or some string returned by
F<L</quote>()>.

=head3 F<is_random_text(SCALAR-REF)>

The opposite of F<L</is_value>()>.  On  such texts F<L</compile>()> amd F<L</compile_fast>()> would
call F<L</quote>()>.

=cut

sub is_integer(\$) { ${$_[0]} =~ $REInteger ? 1 : 0 }
sub is_number(\$) { ${$_[0]} =~ $REFloat ? 1 : 0 }
sub is_symbol(\$) { ${$_[0]} =~ $RESymbol ? 1 : 0 }
sub is_value(\$) { ${$_[0]} =~ $REValue ? 1 : 0 }
sub is_random_text(\$) { ${$_[0]} =~ $REValue ? 0 : 1 }

=head3 F<quote(TEXT)>, F<escape(TEXT)>

Converts TEXT into 7-bit-ASCII.  All characters not in the set of the 95 printable ASCII characters
are escaped  (see below).  The following  ASCII codes will  be converted to escaped  octal numbers,
i.e. 3 digits prefixed by a slash:

    0x00 to 0x1F
    0x80 to 0xFF
    " ' \

The  difference  between  the two  functions  is  that  F<quote()>  additionally places  TEXT  into
double-quotes.    For  example,   F<quote(qq'"FrE<uuml>her   Mittag\n"')>  returns   C<"\"Fr\374her
Mittag\n\"">, while F<escape()> returns C<\"Fr\374her Mittag\n\">

=head3 F<maybe_quote(TEXT)>

Return F<quote(TEXT)> if F<L</is_random_text>(TEXT)>; otherwise (TEXT defines a symbolic name or
number) return TEXT.

=head3 F<maybe_unquote(TEXT)>

Return F<unquote(TEXT)> when the first character of TEXT is C<">; otherwise returns TEXT.

=head3 F<unquote(TEXT)>, F<unescape(TEXT)>

Reverses F<L</quote>()> and F<L</escape>()>.

=head3 F<unhere(HERE-DOC-STRING[, COLUMNS, FIRSTTAB, DEFAULTTAB])>

HERE-DOC-STRING shall be a L<here-document|/Here-Documents>.  The function checks whether each line
begins with  a common prefix,  and if so,  strips that off.   If no prefix  it takes the  amount of
leading whitespace found the first line and removes that much off each subsequent line.

Unless  COLUMNS  is defined  returns  the  new here-doc-string.  Otherwise,  takes  the string  and
reformats it into  a paragraph having no line  more than COLUMNS characters long.  FIRSTTAB will be
the indent  for the first  line, DEFAULTTAB  the indent for  every subsequent line.  Unless passed,
FIRSTTAB and DEFAULTTAB default to the empty string C<"">.

This function combines recipes 1.11 and 1.12 from the Perl Cookbook.

=cut

our(%g_nonprintables_escaped,   # keys are non-printable ASCII chars, values are escape sequences
    %g_escaped_nonprintables,   # keys are escaped sequences, values are the non-printables
    $REnonprintable,
    $REescape_seq);

BEGIN {
    # Perl should not use/require the same module twice. However, the die exception below may fire
    # in case Rlist.pm is symlinked.  For example, when Rlist.pm is installed locally to ~/bin and
    # ~/bin is in @INC, one can say:
    #       use Rlist;
    # to read the package Data::Rlist.  But in order to
    #       use Data::Rlist;
    # as with the regularily installed version (from CPAN), one must create ~/bin/Data/Rlist.pm.
    # If this is a symlink to ~/bin/Rlist.pm the same file might be used twice.

    croak "${\(__FILE__)} used/required twice" if %g_escaped_nonprintables;

    # Tabulate octalization. In previous versions escape() was implemented so
    #
    #   sub _octl {
    #       $n = ord($1);
    #       '\\'.($n >> 6).(($n >> 3) & 7).($n & 7);
    #   }
    #   s/([\x00-\x1F\x80-\xFF])/_octl()/ge # non-printables => \NNN
    #
    # which has now been optimized into
    #
    #   s/$REnonprintable/$g_nonprintables_escaped{$1}/go
    #

    sub escape_char($) {
        my $c = ord($_[0]); # get number code, eg. 'ü' => 252
        '\\'.($c >> 6).(($c >> 3) & 7).($c & 7); # eg. 252 => \374
    }

    sub unescape_char($) {      # w/o leading backslash
        pack('C', oct($_[0]));  # deoctalize eg. 11 => 9 => \t
    }

    $REescape_seq = qr/\\([0-7]{1,3}|[nrt"'\\])/;
    $REnonprintable = qr/([\x00-\x1F\x80-\xFF"'])/;

    # Build tables for non-printable ASCII chararacters.

    %g_nonprintables_escaped = map { chr($_) => escape_char(chr($_)) } (0x00..0x1F, 0x80..0xFF);
    my @v = values %g_nonprintables_escaped;
    foreach (@v) {
        s/^\\// or die;
        croak $_ if exists $g_escaped_nonprintables{$_};
        $g_escaped_nonprintables{$_} = unescape_char($_)
    }

    croak unless keys(%g_nonprintables_escaped) == (255 - 95);
    croak join("  ", keys %g_escaped_nonprintables) unless keys(%g_escaped_nonprintables) == (255 - 95);
    #croak sort keys %g_escaped_nonprintables;

    # Add \ " ' into the tables, which spares another s// call in escape and unescape for
    # them. The leading \ is alredy matched by $REescape_seq.

    $g_nonprintables_escaped{chr(34)} = qq(\\"); # " => \"
    $g_nonprintables_escaped{chr(39)} = qq(\\'); # ' => \'

    $g_escaped_nonprintables{chr(34)} = chr(34);
    $g_escaped_nonprintables{chr(39)} = chr(39);
    $g_escaped_nonprintables{chr(92)} = chr(92);

    # Add \r, \n and \t.

    if (1) {
        $g_nonprintables_escaped{chr( 9)} = qq(\\t); # \t => \\t
        $g_nonprintables_escaped{chr(10)} = qq(\\n); # \n => \\n
        $g_nonprintables_escaped{chr(13)} = qq(\\r); # \r => \\r

        $g_escaped_nonprintables{'t'} = chr( 9);
        $g_escaped_nonprintables{'n'} = chr(10);
        $g_escaped_nonprintables{'r'} = chr(13);
    }
}

sub maybe_quote($) { is_random_text($_[0]) ? quote($_[0]) : $_[0] }
sub maybe_unquote($) { ord($_[0]) == 34 ? unquote($_[0]) : $_[0] }
sub quote($) {
    # Escape, then add quotes (the below expression is faster than qq).
    '"'.escape($_[0]).'"'
}

sub unquote($) {
    # First remove quotes, then unescape. The below expression might look complicated; but it is
    # actually faster than to shift the string from the stack, massage it with s/^\"// and s/\"$//.

    unescape(ord($_[0]) == 34 ? substr($_[0], 1, length($_[0]) - 2) : $_[0])
}

sub escape($) {
    my $s = shift; return '' unless defined $s;
    $s =~ s/\\/\\\\/g;										  # has to happen first, because...
    $s =~ s/$REnonprintable/$g_nonprintables_escaped{$1}/gos; # ...will intersperse more backslashes
    $s
}

sub unescape($) {
    my $s = shift;
    $s =~ s/$REescape_seq/$g_escaped_nonprintables{$1}/gos;
    $s
}

sub unhere($;$$$) {
    # Combines recipes 1.11 and 1.12.
    local $_ = shift;
    my($white, $leader);        # common whitespace and common leading string
    if (/^\s*(?:([^\w\s]+)(\s*).*\n)(?:\s*\1\2?.*\n)+$/) {
        ($white, $leader) = ($2, quotemeta($1));
    } else {
        ($white, $leader) = (/^(\s+)/, '');
    }
    s/^\s*?$leader(?:$white)?//gm;

    # Recipe 1.12
    my($columns, $firsttab, $deftab) = (shift, shift||'', shift||'');
    if ($columns) {
        use Text::Wrap;
        $Text::Wrap::columns = $columns;
        return wrap($firsttab, $deftab, $_);
    } else {
        return $_;
    }
}

=head3 F<split_quoted(INPUT[, DELIMITER])> and F<parse_quoted(INPUT[, DELIMITER])>

Divide the string INPUT into a list of strings.  DELIMITER is a regular expression specifying where
to split (default: C<'\s+'>).   The function won't split at DELIMITERs inside  quotes, or which are
backslashed.  For example, to split INPUT at commas use C<'\s*,\s*'>.

F<parse_quoted()> works like F<split_quoted()> but  additionally removes all quotes and backslashes
from   the   splitted   fields.    Both   functions   effectively   simplify   the   interface   of
F<Text::ParseWords>.  In an array context they return  a list of substrings, otherwise the count of
substrings.    An  empty   array   is  returned   in   case  of   unbalanced  double-quotes,   e.g.
F<split_quoted(C<'foo,"bar'>)>.

B<EXAMPLES>

    sub split_and_list($) {
        print ($i++, " '$_'\n") foreach split_quoted(shift)
    }

    split_and_list(q("fee foo" bar))

        0 '"fee foo"'
        1 'bar'

    split_and_list(q("fee foo"\ bar))

        0 '"fee foo"\ bar'

The default DELIMITER C<'\s+'> handles newlines.  F<split_quoted(C<"foo\nbar\n">)> returns
S<F<('foo', 'bar', '')>> and hence can be used to to split a large string of uncho(m)p'd input
lines into words:

    split_and_list("foo  \r\n bar\n")

        0 'foo'
        1 'bar'
        2 ''

The DELIMITER matches everywhere outside of quoted constructs, so in case of the default C<'\s+'>
you may want to remove heading/trailing whitespace. Consider

    split_and_list("\nfoo")
    split_and_list("\tfoo")

        0 ''
        1 'foo'

and

    split_and_list(" foo ")

        0 ''
        1 'foo'
        2 ''

F<parse_quoted()> additionally removes all quotes and backslashes from the splitted fields:

    sub parse_and_list($) {
        print ($i++, " '$_'\n") foreach parse_quoted(shift)
    }

    parse_and_list(q("fee foo" bar))

        0 'fee foo'
        1 'bar'

    parse_and_list(q("fee foo"\ bar))

        0 'fee foo bar'

B<MORE EXAMPLES>

String C<'field\ one  "field\ two"'>:

    ('field\ one', '"field\ two"')  # split_quoted
    ('field one', 'field two')      # parse_quoted

String C<'field\,one, field", two"'> with a DELIMITER of C<'\s*,\s*'>:

    ('field\,one', 'field", two"')  # split_quoted
    ('field,one', 'field, two')     # parse_quoted

Split a large string F<$soup> (mnemonic: slurped from a file) into lines, at LF or CR+LF:

    @lines = split_quoted($soup, '\r*\n');

Then transform all F<@lines> by correctly splitting each line into "naked" values:

    @table = map { [ parse_quoted($_, '\s*,\s') ] } @lines

Here is some more complete code to parse a F<.csv>-file with quoted fields, escaped commas:

    open my $fh, "foo.csv" or die $!;
    local $/;                   # enable localized slurp mode
    my $content = <$fh>;        # slurp whole file at once
    close $fh;
    my @lines = split_quoted($content, '\r*\n');
    die q(unbalanced " in input) unless @lines;
    my @table = map { [ map { parse_quoted($_, '\s*,\s') } ] } @lines

In core this  is what F<L</read_csv>()> does.  A  nice way to make sure  what F<split_quoted()> and
F<parse_quoted()> return  is using  F<L</deep_compare>()>.  For example,  the following  code shall
never die:

    croak if deep_compare([split_quoted("fee fie foo")], ['fee', 'fie', 'foo']);
    croak if deep_compare( parse_quoted('"fee fie foo"'), 1);

The 2nd call to F<L</parse_quoted>()> happens in scalar context, hence shall return 1 because
there's one string to parse.

=cut

sub split_quoted($;$) {
    # Split [0] at delimiter [1], returning a list of words/tokens.  Delimiter defaults to '\s+'.
    #
    # We've to map the result of parse_line again to build the result. For "foo\nbar\n" parse_line
    # returns ('foo','bar',undef), not ('foo','bar',''). This may cause hard to track "Use of
    # uninitialized value..."  warnings.

    use Text::ParseWords;
    return map { (defined) ? $_ : '' } parse_line($_[1]||'[\s]+', 1, $_[0])
}

sub parse_quoted($;$) {
    use Text::ParseWords;
    return map { (defined) ? $_ : '' } parse_line($_[1]||'[\s]+', 0, $_[0])
}

=head3 F<equal(NUM1, NUM2[, PRECISION])> and F<round(NUM1[, PRECISION])>

Compare   and   round   floating-point   numbers.    NUM1   and  NUM2   are   string-   or   number
scalars. F<L</equal>()>  returns true if  NUM1 and  NUM2 are equal  to PRECISION number  of decimal
places (default: 6).

Normally  F<round()>  will  return a  number  in  fixed-point  notation.  When  the  package-global
F<$Data::Rlist::RoundScientific> is true,  however, F<round()> formats the number  in either normal
or  exponential (scientific)  notation,  whichever is  more  appropriate for  its magnitude.   This
differs slightly from fixed-point notation in that insignificant zeroes to the right of the decimal
point are  not included. Also, the  decimal point is not  included on whole  numbers.  For example,
F<L</round>(42)> does not return 42.000000, and F<round(0.12)> returns 0.12, not 0.120000.

B<MACHINE ACCURACY>

One  needs a  function like  F<equal()> to  compare  floats, because  IEEE 754  single- and  double
precision implementations  are not absolute - in  contrast to the numbers  they actually represent.
In all  machines non-integer  numbers are  only an approximation  to the  numeric truth.   In other
words, they're not commutative.  For example, given  two floats F<a> and F<b>, the result of F<a+b>
might be different than that of F<b+a>.  For another example, it is a mathematical truth that F<a *
b = b * a>, but not necessarily in a computer.

Each machine has its own accuracy, called the F<machine epsilon>, which is the difference between 1
and the smallest exactly representable number greater than one. Most of the time only floats can be
compared that have been carried out to a  certain number of decimal places.  In general this is the
case when  two floats that result  from a numeric operation  are compared - but  not two constants.
(Constants are accurate through to lexical conventions of the language. The Perl and C syntaxes for
numbers simply won't allow you to write down inaccurate numbers.)

See also recipes 2.2 and 2.3 in the Perl Cookbook.

B<EXAMPLES>

    CALL                    RETURNS NUMBER
    ----                    --------------
    round('0.9957', 3)       0.996
    round(42, 2)             42
    round(0.12)              0.120000
    round(0.99, 2)           0.99
    round(0.991, 2)          0.99
    round(0.99, 1)           1.0
    round(1.096, 2)          1.10
    round(+.99950678)        0.999510
    round(-.00057260)       -0.000573
    round(-1.6804e-6)       -0.000002

=cut

sub equal($$;$) {
    my($a, $b, $prec) = @_;
    $prec = 6 unless defined $prec;
    sprintf("%.${prec}g", $a) eq sprintf("%.${prec}g", $b)
}

sub round($;$) {
    # Note that sprintf("%.6g\n", 2006073104) yields 2.00607e+09, which looses digits.
    my $a = shift; return $a if is_integer($a);
    my $prec = shift; $prec = 6 unless defined $prec;
    return sprintf("%.${prec}g", $a) if $RoundScientific;
    return sprintf("%.${prec}f", $a);
}

=head3 F<deep_compare(A, B[, PRECISION, PRINT])>

Compare and  analyze two numbers, strings or  references.  Generates a list  of messages describing
exactly all unequal data.  Hence, for any Perl data F<$a> and F<$b> one can assert:

    croak "$a differs from $b" if deep_compare($a, $b);

When PRECISION  is defined all numbers  in A and  B are F<L</round>()>ed before  actually comparing
them.  When PRINT is true traces progress on F<STDOUT>.

B<RESULT>

Returns an array of messages, each describing unequal data, or data that cannot be compared because
of type- or value-mismatching.  The array is empty when deep comparison of A and B found no unequal
numbers or strings, and only indifferent types.

B<EXAMPLES>

The result is line-oriented, and for each mismatch it returns a single message:

    Data::Rlist::deep_compare(undef, 1)

yields

    <<undef>> cmp <<1>>   stop! 1st undefined, 2nd defined (1)

Some more  complex example.  Deep-comparing  two multi-level data  structures A and B  returned two
messages:

    'String literal' == REF(0x7f224)   stop! type-mismatch (scalar versus REF)
    'Greetings, earthlings!' == CODE(0x7f2fc)   stop! type-mismatch (scalar versus CODE)

Somewhere in  A a string  C<"String literal"> could  not be compared, because  the F<corresponding>
element in B is a reference to a reference. Next it says that C<"Greetings, earthlings!"> could not
be compared because the corresponding element in B is a code reference.

Actually, A and B are identical. B was written  to disk (by F<L</write>()>) and then read back as A
(by F<L</read>()>).  So, why don't they compare anymore?  Because in B the refs F<REF(0x7f224)> and
F<CODE(0x7f2fc)> hide

    \"String literal"

and

    sub { 'Greetings, earthlings!' }

When writing B to  disk F<write()> has dissolved the scalar- and  the code-reference into C<"String
literal"> and C<"Greetings, earthlings!">. Of course, F<deep_compare()> will not do that, so A does
not compare to B anymore.  Note  that despite these two mismatches, F<deep_compare()> had continued
the comparison for all other elements in A and B.  Hence the structures are otherwise identical.

=cut

sub deep_compare($$;$$$);
sub deep_compare($$;$$$)
{
    use Scalar::Util qw/reftype blessed looks_like_number/;

    sub prind($@) { my $ind = shift||0; print STDERR chr(9) x $ind, join(' ', grep { defined } @_), chr(10) }
	#sub quot($) { my $s = shift; $s =~ s/([\n\r\t])/\\&ord($1)/ge; "'$s'" }
	sub quot($) { my $s = shift; defined($s) ? "'$s'" : 'undef' }

    my(@R);
    my($a, $b, $prec, $dump, $ind) = @_;
    my($atp, $btp) = (reftype($a), reftype($b)); # undef, SCALAR, ARRAY or HASH
    my($anm, $bnm, $refs) = (0, 0, defined($atp));
	my $prefix = sub { quot($a).($anm ? ' == ' : ' cmp ').quot($b) };
    my($mismatch, $match) = sub { # use "lazy instantiation", so that this sub isn't compiled for
                                  # the majority of cases (when two values are equal)
		my $s = shift; eval 'push @R, $prefix->()."\tStop! ".$s; prind($ind, $R[$#R]) if $dump;'
	};
    $match = sub { my $s = shift; eval 'prind($ind, $prefix->(), $s)' } if $dump;
	$ind ||= 0;

    unless ($refs) {			# unless $a is a reference
		unless (defined $a) {
			$atp = 'undef';
			if (defined $b) {
				$mismatch->('only 2nd defined');
			} else {
				$match->() if $dump; # both undef'd
			} return @R;
		} else {
			unless (defined $b) {
				$mismatch->('only 1st defined');
				return @R;
			}
			$atp = ($anm = is_number($a)) ? 'number' : 'string';
			$a = round($a, $prec) if $anm and defined $prec;
		}
	}
    unless (defined $btp) {
		unless (defined $b) {
			$btp = 'undef';
			if (defined $a) {
				$mismatch->('only 1st defined');
			} else {
				$match->() if $dump; # both undef'd
			} return @R;
		} else {
			unless (defined $a) {
				$mismatch->('only 2nd defined');
				return @R;
			}
			$btp = ($bnm = is_number($b)) ? 'number' : 'string';
			$b = round($b, $prec) if $bnm and defined $prec;
		}
	}
	#die unless defined $a && defined $b;
	if ($atp ne $btp) {
		$mismatch->("type-mismatch, $atp vs. $btp");
		return @R;
	}

	# At this point $a and $b have equal types.
    unless ($refs) {
		# Compare numbers/strings.
        if ($anm) {
			$prec = (defined $prec) ? " precision=$prec" : '';
            unless (equal($a, $b)) {
                $mismatch->($prec)
            } elsif ($dump) {
                $match->($prec)
            }
        } elsif ($a ne $b) {
            $mismatch->('unequal strings')
        } elsif ($dump) {
			$match->()
        } return @R
    } else {
		# Deep-compare two references.
		my $recurse = sub($$) { deep_compare($_[0], $_[1], $prec, $dump, $ind + 1) };
		prind($ind, $prefix->()) if $dump;
		if ($atp eq 'SCALAR') {
			# Two scalars refs.
			push @R, $recurse->($$a, $$b);
			return @R
		} elsif ($atp eq 'HASH') {
			# Deep-compare two hashes.  First test number of key/value-pairs.
			my $acnt = keys %$a;
			my $bcnt = keys %$b;
			unless ($acnt == $bcnt) {
				$mismatch->("different number of keys ($acnt, $bcnt)");
				return @R;
			} return @R if $acnt == 0; # no keys

			# Although both hashes have an equal number of keys, make sure that the keys themselves
			# are equal, and only then compare values.
			my @a_keys_missing = grep { not exists $b->{$_} } keys %$a;
			my @b_keys_missing = grep { not exists $a->{$_} } keys %$b;

			if (@a_keys_missing || @b_keys_missing) {
				$mismatch->('1st hash misses keys ('.join(', ', map { quote($_) } @a_keys_missing).")") if @a_keys_missing;
				$mismatch->('2nd hash misses keys ('.join(', ', map { quote($_) } @b_keys_missing).")") if @b_keys_missing;
				return @R;
			}

			foreach (keys %$a) {
				prind($ind, "key '$_'") if $dump;
				push @R, $recurse->($a->{$_}, $b->{$_});
			}
		} elsif ($atp eq 'ARRAY') {
			# Deep-compare two arrays.
			if ($#$a != $#$b) {
				$mismatch->("different array sizes: ${\(1+$#$a)} vs. ${\(1+$#$b)}")
			} else {
				for (0 .. $#$a) {
					prind($ind, "index [$_]") if $dump;
					push (@R, $recurse->($a->[$_], $b->[$_]))
				}
			}
		} elsif ($atp eq 'REF') {
			# Reference to reference.
			$recurse->($$a, $$b)
		} else {
			$mismatch->("cannot compare types $atp");
		}
	} return @R;
}

=head3 F<fork_and_wait(PROGRAM[, ARGS...])>

Forks a process  and waits for completion.   The function will extract the  exit-code, test whether
the process  died and  prints status messages  on F<STDERR>.   F<fork_and_wait()> hence is  a handy
wrapper around the built-in F<system()> and F<exec()> functions.  Returns an array of three values:

    ($exit_code, $failed, $coredump)

F<$exit_code> is -1  when the program failed to  execute (e.g. it wasn't found or  the current user
has insufficient rights).  Otherwise F<$exit_code> is between  0 and 255.  When the program died on
receipt of a signal (like F<SIGINT> or  F<SIGQUIT>) then F<$signal> stores it. When F<$coredump> is
true the program died and a F<core>-file was written.

=head3 F<synthesize_pathname(TEXT...)>

Concatenates and  forms all  TEXT strings  into a  symbolic name that  can be  used as  a pathname.
F<synthesize_pathname()>  is a useful  function to  concatenate strings  and nearby  converting all
characters that  do not qualify as  filename-characters, into C<"_"> and  C<"-">.  Effectively this
function returns a  symbolic name.  The result cannot only  be used as file- or  URL name, but also
(coinstantaneously) as hash key, database name etc.

=cut

sub fork_and_wait(@)
{
    my $prog = shift;
    my($exit_code, $signal, $coredump);
    local $| = 1;
    system($prog, @_);          # == 0 or die "\n\tfailed: $?";
    if ($? == -1) {             # not found
        $exit_code = -1;
        print STDERR "\n\tfailed to execute program: $!\n";
    } elsif ($? & 127) {        # died
        $exit_code = -1;
        $signal = ($? & 127);
        $coredump = ($? & 128);
        print STDERR "\n\tchild died with signal %d, %s core-dump\n", $signal, $coredump ? 'with' : 'without';
    } else {                    # ok
        $exit_code = $? >> 8;
        printf STDERR "\n\tchild exited with value %d\n", $exit_code, "\n" if $DEBUG;
    }
    return ($exit_code, $signal, $coredump)
}

sub synthesize_pathname(@)
{
    my @s = @_;
    my($dch1, $dch2) = ('-', '_');
    join('_',
		 map {
			 # Unquote.
			 s/^"(.+)"\z/$1/;
			 # Escape all non-printables.
			 $_ = escape($_);
			 # Undo \" \'
			 s/\\(["'])/$1/go;
			 s/[']/_/g;
			 s/"(.+)"/$dch2$dch2$1$dch2$dch2/o; # "xxx" within string => __xxx__
			 # Handle \NNN
			 s/[\\]/0/g; # eg. \347 => 0347
			 # Filename
			 s/[\(\|\)\/:;]/$dch1/go;			 # ( | ) / : ; ==> -
			 s/[\^<>:,;\"\$\s\?!\&\%\*]/$dch2/go; # ^ < > " $ ? ! & % * , ; : wsp => _
			 s/^[\-\s]+|[\-\s]+\z//o;
			 $_
		 } @s
        )
}

=head2 Exported Functions

=head3 Exporter Tags

Three tags are available that import function sets. These are utility functions usable also
separately from F<Data::Rlist>.  For example,

    use Data::Rlist qw/:floats :strings/;

=over

=item F<:floats>

Imports F<L</equal>()>, F<L</round>()> and F<L</is_number>()>.

=item F<:strings>

Imports F<L</maybe_quote>()>, F<L</quote>()>, F<L</escape>()>, F<L</unquote>()>, F<L</unescape>()>,
F<L</unhere>()>, F<L</is_random_text>()>, F<L</is_number>()>, F<L</is_symbol>()>, F<L</split_quoted>()>, and
F<L</parse_quoted>()>.

=item F<:options>

Imports F<L</predefined_options>()> and F<L</complete_options>()>.

=item F<:aux>

Imports F<L</deep_compare>()>, F<L</fork_and_wait>()> and F<L</synthesize_pathname>()>.

=back

=head3 Auto-Exported Functions

The following functions are implicitly imported into the callers symbol table.  (But you may say
F<require Data::Rlist> instead of F<use Data::Rlist> to prohibit auto-import.  See also
L<perlmod>.)

=head3 F<ReadData(INPUT[, FILTER, FILTER-ARGS])>

=head3 F<ReadCSV(INPUT[, OPTIONS, FILTER, FILTER-ARGS])>

=head3 F<ReadConf(INPUT[, OPTIONS, FILTER, FILTER-ARGS])>

These    are   aliases    for   F<Data::Rlist::L</read>()>,    F<Data::Rlist::L</read_csv>()>   and
F<Data::Rlist::L</read_conf>()>.

=head3 F<WriteData(DATA[, OUTPUT, OPTIONS, HEADER])>

=head3 F<WriteCSV(DATA[, OUTPUT, OPTIONS, COLUMNS, HEADER])>

=head3 F<WriteConf(DATA[, OUTPUT, OPTIONS, HEADER])>

These   are   aliases    for   F<Data::Rlist::L</write>()>,   F<Data::Rlist::L</write_csv>()>   and
F<Data::Rlist::L</write_conf>()>.

=head3 F<OutlineData(DATA[, OPTIONS])>

=head3 F<StringizeData(DATA[, OPTIONS])>

=head3 F<SqueezeData(DATA[, OPTIONS])>

These are  aliases for F<Data::Rlist::L</make_string>()>.  F<OutlineData()>  applies the predefined
L<C<"outlined">|/Predefined     Options>      options,     while     F<StringizeData()>     applies
L<C<"string">|/Predefined Options> and F<SqueezeData>() L<C<"squeezed">|/Predefined Options>.  When
specified, OPTIONS are  merged into the predefined set by  means of F<L</complete_options>()>.  For
example,

    print "\n\$thing: ", OutlineData($thing, { precision => 12 });

F<L<rounds|/round>()> all numbers in F<$thing> to 12 digits.

=head3 F<PrintData(DATA[, OPTIONS])>

Just another way for

    print OutlineData(DATA, OPTIONS);

=head3 F<KeelhaulData(DATA[, OPTIONS])>

=head3 F<CompareData(A, B[, PRECISION, PRINT_TO_STDOUT])>

These are  aliases for F<L</keelhaul>()> and F<L</deep_compare>()>. For example,

    use Data::Rlist;
        .
        .
    my($copy, $as_text) = KeelhaulData($thing);

=cut

sub ReadCSV($;$$$) {
    my($input, $options, $fcmd, $fcmdargs) = @_;
    Data::Rlist::read_csv($input, $options, $fcmd, $fcmdargs);
}

sub ReadConf($;$$$) {
    my($input, $options, $fcmd, $fcmdargs) = @_;
    Data::Rlist::read_conf($input, $options, $fcmd, $fcmdargs);
}

sub ReadData($;$$) {
    my($input, $fcmd, $fcmdargs) = @_;
    Data::Rlist::read($input, $fcmd, $fcmdargs);
}

sub WriteCSV($;$$$$) {
    my($data, $output, $options, $columns, $header) = @_;
    Data::Rlist::write_csv($data, $output, $options, $columns, $header);
}

sub WriteConf($;$$$) {
    my($data, $output, $options, $header) = @_;
    Data::Rlist::write_conf($data, $output, $options, $header);
}

sub WriteData($;$$$) {
    my($data, $output, $options, $header) = @_;
    Data::Rlist::write($data, $output, $options, $header);
}

sub PrintData($;$) {
    print OutlineData(@_)
}

sub OutlineData($;$) {          # return outlined data as string
    my($data, $options) = @_;
    Data::Rlist::make_string($data, complete_options($options, 'outlined'));
}

sub StringizeData($;$) { # return data as compact string (mainly this means no newlines)
    my($data, $options) = @_;
    Data::Rlist::make_string($data, complete_options($options, 'string'));
}

sub SqueezeData($;$) { # return data as very compact string (no whitespace at all)
    my($data, $options) = @_;
    Data::Rlist::make_string($data, complete_options($options, 'squeezed'));
}

sub KeelhaulData($;$) {         # recursively copy data
    my($data, $options) = @_;
    Data::Rlist::keelhaul($data, $options);
}

sub CompareData($$;$$) {        # recursively compare data
    my($a, $b, $prec, $dump) = @_;
    Data::Rlist::deep_compare($a, $b, $prec, $dump);
}

=head1 NOTES

The  F<Random Lists> (Rlist)  syntax is  inspired by  NeXTSTEP's F<Property  Lists>.  But  Rlist is
simpler,  more readable and  more portable.   The Perl,  Python and  C++ implementations  are fast,
stable and  free.  Markus Felten,  with whom I worked  a few month  in a project at  Deutsche Bank,
Frankfurt in  summer 1998,  arrested my  attention on Property  lists.  He  had implemented  a Perl
variant of it (F<L<http://search.cpan.org/search?dist=Data-PropertyList>>).

The term "Random" underlines the fact that the language

=over

=item *

has four primitive/anonymuous types;

=item *

the basic building block is a list, which is combined at random with other lists.

=back

Hence the term F<Random> does not mean F<aimless> or F<accidental>.  F<Random Lists> are
F<arbitrary> lists.

=head2 Rlist vs. Perl Syntax

Rlists are not Perl syntax:

    RLIST    PERL
    -----    ----
     5;       { 5 => undef }
     "5";     { "5" => undef }
     5=1;     { 5 => 1 }
     {5=1;}   { 5 => 1 }
     (5)      [ 5 ]
     {}       { }
     ;        { }
     ()       [ ]

=head2 Speeding up Compilation (Explicit Quoting)

Much work has been spent to optimize F<Data::Rlist> for speed.  Still it is implemented in pure
Perl (no XS).  A very rough estimation for Perl 5.8 is "each MB takes one second per GHz".  For
example, when the resulting Rlist file has a size of 13 MB, compiling it from a Perl script on a
3-GHz-PC requires about 5-7 seconds.  Compiling the same data under Solaris, on a sparcv9 processor
operating at 750 MHz, takes about 18-22 seconds.

The process of compiling can be speed up by calling F<L</quote>()> explicitly on scalars. That is,
before calling F<L</write>()> or F<L</write_string>()>.  Big data sets may compile faster when for
scalars, that certainly not qualify as symbolic name, F<L</quote>()> is called in advance:

    use Data::Rlist qw/:strings/;

    $data{quote($key)} = $value;
        .
        .
    Data::Rlist::write("data.rlist", \%data);

instead of

    $data{$key} = $value;
        .
        .
    Data::Rlist::write("data.rlist", \%data);

It   depends  on   the  case   whether   the  first   variant  is   faster:  F<L</compile>()>   and
F<L</compile_fast>()> both have to call F<L</is_random_text>()> on each scalar.  When the scalar is
already quoted, i.e., its first character is C<">, this test ought to run faster.

Note     that    internally     F<L</is_random_text>()>    applies     the     precompiled    regex
F<$Data::Rlist::REValue>.    But   for  a   given   scalar   F<$s>   the  expression   S<F<($s   !~
$Data::Rlist::REValue)>> can be up to 20% faster than the equivalent F<is_random_text($s)>.

=head2 Quoting strings that look like numbers

Normally  you  don't  have to  care  about  strings,  since  un/quoting  happens as  required  when
reading/compiling Rlist  or CSV text.   A common problem,  however, occurs when some  text fragment
(string) uses  the same lexicography  than numbers do.

Perl defines F<the string> as the basic building  block for all program data, then lets the program
decide F<what strings mean>.   Analogical, in a printed book the reader  has to decipher the glyphs
and  decide  what evidence  they  hide.   Printed text  uses  well-defined  glyphs and  typographic
conventions, and finally the competence of the reader, to recognize numbers.  But computers need to
know the exact number type and  format.  Integer?  Float?  Hexadecimal?  Scientific?  Klingon?  The
Perl Cookbook recommends the use of a  regular expression to distinguish number from string scalars
(recipe 2.1).

In Rlist, string scalars that look like numbers need to be quoted explicitly.  Otherwise, for
example, the string scalar C<"-3.14"> appears as F<-3.14> in the output. Likewise C<"007324"> is
compiled into 7324. Then the text quality is lost and the scalar is read back as a number.  Of
course, this behavior is by intend, and in most cases this is just what you want. For hash keys,
however, it might be a problem.  One solution is to prefix the string with C<"_">:

    my $s = '-9'; $s = "_$s";

Such strings do not qualify as a number anymore.  In the C++ implementation it will then become
some F<std::string>, not a F<double>.  But the leading C<"_"> has to be removed by the reading
program.  Perhaps a better solution is to explicitly call F<Data::Rlist::quote>:

    $k = -9;
    $k = Data::Rlist::quote($k); # returns qq'"-9"'

    use Data::Rlist qw/:strings/;

    $k = 3.14_15_92;
    $k = quote($k);             # returns qq'"3.141592"'

Again, the  need to quote  strings that  look like numbers  is a problem  evident only in  the Perl
implementation of Rlist, since  Perl is a language with weak types. As  a language with very strong
typing C++ is quasi the antipode to Perl. With the C++ implementation of Rlist then there's no need
to  quote   strings  that  look   like  numbers.   See  also   F<L</write>()>,  F<L</is_number>()>,
F<L</is_symbol>()>,                           F<L</is_random_text>()>                           and
F<L<http://en.wikipedia.org/wiki/American_Standard_Code_for_Information_Interchange>>.

=head2 Installing F<Rlist.pm> locally

Installing CPAN  packages usually requires  administrator privileges.  Another  way is to  copy the
F<Rlist.pm> file  into a directory of  your choice, e.g. into  F<.> or F<~/bin>.   Instead of F<use
Data::Rlist;>, however,  you then use the  following code.  It  finds F<Rlist.pm> also in  F<.> and
F<~/bin>, and then calls the F<Exporter> manually:

    BEGIN {
        $0 =~ /[^\/]+$/;
        push @INC, $`||'.', "$ENV{HOME}/bin";
        require Rlist;
        Data::Rlist->import();
        Data::Rlist->import(qw/:floats :strings/);
    }

=head2 Package Dependencies

F<Data::Rlist> depends only on few other packages:

    Exporter
    Carp
    strict
    integer
    Sys::Hostname
    Scalar::Util        # deep_compare() only
    Text::Wrap          # unhere() only
    Text::ParseWords    # split_quoted(), parse_quoted() only

F<Data::Rlist> is free of F<$&>, F<$`> or F<$'>. Reason: once Perl sees that you need one of these
meta-variables anywhere in the program, it has to provide them for every pattern match.  This may
substantially slow your program (see also L<perlre>).

=head2 Background: A Short Story of Typeglobs

F<This is supplement information for L</compile>().>

Typeglobs are  an idiosyncracy  of Perl.  Typeglob objects are  symbol table  entries. Perl  uses a
symbol table per package (namespace) to map  symbolic names like F<foo> to Perl values.  Humans use
abstract symbols to name  things, because we can remember symbols better  than numbers, or formulas
that hide numbers.

The idiosyncracy  is that different types need  only one entry -  one symbol can name  all types of
Perl data  (scalars, arrays, hashes) and  nondata (functions, formats, I/O  handles).  For example,
the symbol F<foo>  is mapped to the  typeglob F<*foo>. Therein coexist F<$foo>  (the scalar value),
F<@foo> (the list  value), F<%foo> (the hash value),  F<&foo> (the code value) and  F<foo> (the I/O
handle or the format  specifier).  There's no key C<"$foo"> or C<"@foo">  in the symbol table, only
C<"foo">.

The symbol table  is an ordinary hash, named  like the package with two colons  appended.  The main
symbol table's  name is  thus F<%main::>,  or F<%::>.  Internally  this is  called a  F<stash> (for
symbol table hash).  F<perl> will create one stash per package.

In the C code that implements Perl,  F<%::> is the global variable F<defstash> (default stash).  It
holds items in the F<main> package.  But, as if it were a symbol in a stash, F<perl> arranges it as
typeglob-ref:

    $ perl -e 'print \*::'
    GLOB(0x10010f08)

But the root-stash F<defstash> lists stashes from all other packages. For example, the symbol
F<Data::> in stash F<%::> addresses the stash of package F<Data>, and the symbol F<Rlist::> in the
stash F<%Data::> addresses the stash of package F<Data::Rlist>.

Like all hashes stashes contain string keys, which name symbols, and values which are typeglobs.
In the C implementation of Perl typeglobs have the F<struct> type F<GV>, for F<Glob value>.
In the stashes, typeglobs are F<GV> pointers.

=over

=item *

The typeglob is interposed between the stash and the program's actual values for F<$foo>, F<@foo>
etc.

=item *

The sigil F<*> serves as wildcard for the other sigils F<%>, F<@>, F<$> and F<&>. (A F<sigil> is a
symbol created for a specific magical purpose; the name derives from the latin F<sigilum> = seal.)

=item *

F<\*names::> are actually stash-refs, but Perl calls them globs.

=back

Modifying  F<$foo> in  a Perl  program won't  change F<%foo>.   Each typeglob  is merely  a  set of
pointers  to  separate objects  describing  scalars, arrays,  hashes,  functions,  formats and  I/O
handles.   Normally only  one pointer  in F<*foo>  is non-null.   Because typeglobs  host pointers,
F<*foo{ARRAY}> is a way to say F<\@foo>. To  get a reference to the typeglob for symbol F<*foo> you
say F<*foo{GLOB}>, or F<\*foo>.  But it is not quite clear why F<perl> this is an error:

    $ perl -e 'exists *foo{GLOB}'
    exists argument is not a HASH or ARRAY element at -e line 1.

To define the scalar pointer in the typeglob F<*foo> you simply say S<F<$foo = 42>>. But you may
also assign a reference to the typeglob:

    $ perl -e '$x = 42; *foo = \$x; print $foo'
    42

Assigning a scalar alters the symbol, not the typeglob:

    $ perl -e '$x = 42; *foo = $x; print *foo'
    *main::42
    $ perl -e '$x = 42; *foo = $x; print *42'
    *main::42

Consider also:

    $ perl -e 'print 1*9'
    9
    $ perl -e 'print *9'
    *main::9

And also:

    $ perl -e '*foo = 42; print $::{42}, *foo'
    *main::42*main::42

IMHO it should not do that.

Maybe the best use of typeglobs are F<Typeglob-aliases>. For example, S<F<*bar = *foo>> aliases the
symbol F<bar> in the  stash.  Then the symbols F<foo> and F<bar> point  to the same typeglob!  This
means that when  you declare S<F<sub foo {}>>  after casting the alias, F<bar()>  is F<foo()>.  The
penalty, however, is that the F<bar> symbol cannot be easily removed from the stash.  One way is to
say  F<local *bar>, wich  temporarily assigns  a new  typeglob to  F<bar> (in  its stash)  with all
pointers zeroized.

What is this good for?  This is not quite clear. Obviously an artefact from Perl4, it once made old
scripts compatible with Perl5.  In fact, F<local> typeglob aliases seem to be faster than
references, because no dereferencing is required. For example,

    void f1 { my $bar = shift; ++$$bar }
    void f2 { local *bar = shift; ++$bar }

    f1(\$foo);                  # increments $foo
    f1(*foo);                   # dto., but faster

Note, however, that F<my>  variables (lexical variables) are not stored in  stashes, and do not use
typeglobs.  These variables are  stored in  a special  array, the  F<scratchpad>, assigned  to each
block, subroutine, and thread. These are really private variables, and they cannot be F<local>ized.
Each lexical variable  occupies a slot in the  scratchpad; hence is addressed by  an integer index,
not a symbol. F<my> variables are like  F<auto> variables in C. They're also faster than F<local>s,
because they can  be allocated at compile  time, not runtime. Therefore you  cannot declare F<*foo>
lexically:

    $ perl -e 'my(*foo);'
    Can't declare ref-to-glob cast in "my" at -e line 1, near ");"
    Execution of -e aborted due to compilation errors.

Also it is somewhat confusing that F<$foo> and F<@foo> etc. have concrete values, while
F<*foo> does not strip into

    (SCALAR => \$foo, HASH => \@foo)

in case, for example, F<$foo> and C<%foo> had incarnated.  Instead it is said to be F<*main::foo>:

    $ perl -e 'print *foo'
    *main::foo

As one  can see the  stash entry is  arranged by F<perl>  on the fly,  even with the  F<use strict>
pragma in effect:

    $ perl -e 'package nirvana; use strict; print *foo;'
    *nirvana::foo

So the value of a typeglob is a full path into the F<perl> stashes, down from the F<defstash>.  But
what actually is F<*main::foo>?

    $ perl -e 'print "*foo is not interpolated"'
    *foo is not interpolated
    $ perl -e 'print "although ".*foo." could be a string"'
    although *main::foo could be a string
    $ perl -e 'print "*foo is \"*main::foo\"" if *foo eq "*main::foo"'
    *foo is "*main::foo"
    $ perl -e 'package nirvana; sub f { local *g=shift; print *g."=$g" }; package main; $foo=42; nirvana::f(*foo)'
    *main::foo=42

Conclusion: with typeglobs you reach the bedrock of F<perl>, where the spade bends back.

More on this L<perlguts>, L<perlref>, L<perldsc> and L<perllol>.

=head1 BUGS

There are no known bugs, this package is stable.

Deficiencies and TODOs:

=over

=item *

The C<"deparse"> functionality for the C<"code_refs"> L<compile option|/Compile Options> has not
yet been implemented.

=item *

The C<"threads"> L<compile option|/Compile Options> has not yet been implemented.

=item *

IEEE 754 notations of Infinite and NaN not yet implemented.

=item *

F<L</compile_Perl>()> is experimental.

=back

=head1 SEE ALSO

=head2 F<Data::Dumper>

In contrast to the F<Data::Dumper>, F<Data::Rlist> scalars will be properly F<typed> as number or
string.  F<Data::Dumper> writes numbers always as quoted strings, for example

    $VAR1 = {
                'configuration' => {
                                    'verbose' => 'Y',
                                    'importance_sampling_loss_quantile' => '0.04',
                                    'distribution_loss_unit' => '100',
                                    'default_only' => 'Y',
                                    'num_threads' => '5',
                                            .
                                            .
                                   }
            };

where F<Data::Rlist> writes

    {
        configuration = {
            verbose = Y;
            importance_sampling_loss_quantile = 0.04;
            distribution_loss_unit = 100;
            default_only = Y;
            num_threads = 5;
                .
                .
        };
    }

As one can see F<Data::Dumper> writes the data right in Perl syntax, which means the dumped text
can be simply F<eval>'d, and the data can be restored very fast. Rlists are not quite Perl-syntax:
a dedicated parser is required.  But therefore Rlist text is portable and can be read from other
programming languages, namely C++, where a fast flex/bison-parser in conjunction with a smart heap
management is implemented. So C++ programs, like Perl programs, are able to handle Rlist files of
several hundred MB.

With F<$Data::Dumper::Useqq> enabled it was observed that F<Data::Dumper> renders output
significantly slower than F<L</compile>()>. This is actually suprising, since F<Data::Rlist> tests
for each scalar whether it is numeric, and truely quotes/escapes strings.  F<Data::Dumper> quotes
all scalars (including numbers), and it does not escape strings.  This may also result in some odd
behaviors.  For example,

    use Data::Dumper;
    print Dumper "foo\n";

yields

    $VAR1 = 'foo
    ';

while

    use Data::Rlist;
    PrintData "foo\n"

yields

    { "foo\n"; }

(Recall that F<L</parse>()> always returns a list, as array- or hash-reference.)

Finally, F<Data::Rlist> generates smaller files.  With the default F<$Data::Dumper::Indent> of 2
F<Data::Dumper>'s output is 4-5 times that of F<Data::Rlist>'s. This is because F<Data::Dumper>
recklessly uses blanks, instead of horizontal tabulators, which blows up file sizes without
measure.

=head1 COPYRIGHT/LICENSE

Copyright 1998-2007 Andreas Spindler

Maintained at CPAN (F<L<http://search.cpan.org/search?dist=Data-PropertyList>>) and the author's
site (F<L<http://www.visualco.de>>). Please send mail to F<rlist@visualco.de>.

This library is free software; you can redistribute it and/or modify it under the same terms as
Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have
available.

Thank you for your attention.

=cut

1;

### Local Variables:
### buffer-file-coding-system: iso-latin-1
### fill-column: 99
### End:
