# Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/
#
# Copyright (C) 1999-2018 Peter Thoeny, peter[at]thoeny.org
# and TWiki Contributors. All Rights Reserved. TWiki Contributors
# are listed in the AUTHORS file in the root of this distribution.
# NOTE: Please extend that file, not this notice.
#
# Additional copyrights apply to some or all of the code in this
# file as follows:
# Derived from Contrib::Attrs, which is
# Copyright (C) 2001 Motorola - All rights reserved
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 3
# of the License, or (at your option) any later version. For
# more details read LICENSE in the root of this distribution.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
#
# As per the GPL, removal of this notice is prohibited.

=pod

---+ package TWiki::Attrs

Class of attribute sets, designed for parsing and storing attribute values
from a TWiki tag e.g. =%<nop>TAG{"joe" fred="bad" joe="mad"}%=

An attribute set is a hash containing an entry for each parameter. The
default parameter (unnamed quoted string) is named <code>_<nop>DEFAULT</code> in the hash.

Attributes declared later in the string will override those of the same
name defined earlier. The one exception to this is the _DEFAULT key, where
the _first_ instance is always taken.

As well as the default TWiki syntax (parameter values double-quoted)
this class also parses single-quoted values, unquoted spaceless
values, spaces around the =, and commas as well as spaces separating values.
The extended syntax has to be enabled by passing the =$friendly= parameter
to =new=.

=cut

package TWiki::Attrs;

use strict;
use Assert;

use vars qw( $ERRORKEY $DEFAULTKEY $RAWKEY );

$ERRORKEY   = '_ERROR';
$DEFAULTKEY = '_DEFAULT';
$RAWKEY     = '_RAW';

=pod

---++ ClassMethod new ($string, $friendly) => \%attrsObjectRef

   * =$string= - String containing attribute specification
   * =$friendly= - if true, the parse will be according to the extended syntax pioneered by the original Contrib::Attrs. Otherwise it will be strict as per traditional TWiki syntax.

Parse a standard attribute string containing name=value pairs and create a new
attributes object. The value may be a word or a quoted string. If there is an
error during parsing, the parse will complete but $attrs->{_ERROR} will be
set in the new object. $attrs->{_RAW} will always contain the full unprocessed
$string.

Extended syntax example:
<verbatim>
my $attrs = new TWiki::Attrs('the="time \\"has come", "the walrus" said to=speak of=\'many \\'things\', 1);
</verbatim>
In this example:
   * =the= will be =time "has come=
   * <code>_<nop>_<nop>default__</code> will be =the walrus=
   * =said= will be =on=
   * =to= will be =speak=
   * =of= will be =many 'things=

Only " and ' are escaped.

Traditional syntax is as old TWiki, except that the whole string is parsed
(the old parser would only recognise default values in position 1, nowhere
else)

=cut

sub new {
    my ( $class, $string, $friendly ) = @_;
    my $this = bless( {}, $class );

    $this->{$RAWKEY} = $string;

    return $this unless defined( $string );

    $string =~ s/\\(["'])/$TWiki::TranslationToken.sprintf("%.2u", ord($1))/ge;  # escapes

    my $sep = ( $friendly ? "[\\s,]" : "\\s" );
    my $first = 1;

    if( !$friendly && $string =~ s/^\s*\"(.*?)\"\s*(\w+\s*=\s*\"|$)/$2/s ) {
        $this->{$DEFAULTKEY} = $1;
    }
    while ( $string =~ m/\S/s ) {
        # name="value" pairs
        if ( $string =~ s/^$sep*(\w+)\s*=\s*\"(.*?)\"//is ) {
            $this->{$1} = $2;
            $first = 0;
        }
        # simple double-quoted value with no name, sets the default
        elsif ( $string =~ s/^$sep*\"(.*?)\"//os ) {
            $this->{$DEFAULTKEY} = $1
              unless defined( $this->{$DEFAULTKEY} );
            $first = 0;
        }
        elsif ( $friendly ) {
            # name='value' pairs
            if ( $string =~ s/^$sep*(\w+)\s*=\s*'(.*?)'//is ) {
                $this->{$1} = $2;
            }
            # name=value pairs
            elsif ( $string =~ s/^$sep*(\w+)\s*=\s*([^\s,\}\'\"]*)//is ) {
                $this->{$1} = $2;
            }
            # simple single-quoted value with no name, sets the default
            elsif ( $string =~ s/^$sep*'(.*?)'//os ) {
                $this->{$DEFAULTKEY} = $1
                  unless defined( $this->{$DEFAULTKEY} );
            }
            # simple name with no value (boolean, or _DEFAULT)
            elsif ( $string =~ s/^$sep*([a-z]\w*)\b//is ) {
                my $key = $1;
                $this->{$key} = 1;
            }
            # otherwise the whole string - sans padding - is the default
            else {
                if( $string =~ m/^\s*(.*?)\s*$/s &&
                      !defined($this->{$DEFAULTKEY})) {
                    $this->{$DEFAULTKEY} = $1;
                }
                last;
            }
        } elsif( $string =~ m/^\s*(.*?)\s*$/s ) {
            $this->{$DEFAULTKEY} = $1 if( $first );
            last;
        }
    }
    foreach my $k ( keys %$this ) {
        $this->{$k} =~ s/$TWiki::TranslationToken(\d\d)/chr($1)/geo;  # escapes
    }
    return $this;
}

=pod

---++ ObjectMethod isEmpty() -> boolean

Return false if attribute set is not empty.

=cut

sub isEmpty {
    my $this = shift;

    foreach my $k ( keys %$this ) {
        return 0 if $k ne $RAWKEY;
    }
    return 1;
}

=pod

---++ ObjectMethod remove($key) -> $value

   * =$key= - Attribute to remove
Remove an attr value from the map, return old value. After a call to
=remove= the attribute is no longer defined.

=cut

sub remove {
    my ( $this, $attr ) = @_;
    my $val = $this->{$attr};
    delete( $this->{$attr} ) if ( exists $this->{$attr} );
    return $val;
}

=pod

---++ ObjectMethod stringify() -> $string

Generate a printed form for the map, using strict
attribute syntax, with only the single-quote extension
syntax observed (no {} brackets, though).

=cut

sub stringify {
    my $this = shift;
    my $key;
    my @ss;
    foreach $key ( sort keys %$this ) {
        if ( $key ne $ERRORKEY && $key ne $RAWKEY ) {
            my $es = ( $key eq $DEFAULTKEY ) ? '' : $key.'=';
            my $val = $this->{$key};
            $val =~ s/"/\\"/g;
            push( @ss, $es.'"'.$val.'"' );
        }
    }
    return join( ' ', @ss );
}


# ---++ StaticMethod extractValue() -> $string
#
# Legacy support, formerly known as extractNameValuePair. This
# static method uses context information to determine how a value
# string is to be parsed. For example, if you have an attribute string
# like this:
#
# "abc def="ghi" jkl" def="qqq"
#
# then call extractValue( "def" ), it will return "ghi".

sub extractValue {
    my( $str, $name ) = @_;

    my $value = '';
    return $value unless( $str );
    $str =~ s/\\\"/\\$TWiki::TranslationToken/g;  # escape \"

    if( $name ) {
        # format is: %VAR{ ... name = "value" }%
        if( $str =~ /(^|[^\S])$name\s*=\s*\"([^\"]*)\"/ ) {
            $value = $2 if defined $2;  # distinguish between '' and "0"
        }

    } else {
        # test if format: { "value" ... }
        if( $str =~ /(^|\=\s*\"[^\"]*\")\s*\"(.*?)\"\s*(\w+\s*=\s*\"|$)/ ) {
            # is: %VAR{ "value" }%
            # or: %VAR{ "value" param="etc" ... }%
            # or: %VAR{ ... = "..." "value" ... }%
            # Note: "value" may contain embedded double quotes
            $value = $2 if defined $2;  # distinguish between '' and "0";

        } elsif( ( $str =~ /^\s*\w+\s*=\s*\"([^\"]*)/ ) && ( $1 ) ) {
            # is: %VAR{ name = "value" }%
            # do nothing, is not a standalone var

        } else {
            # format is: %VAR{ value }%
            $value = $str;
        }
    }
    $value =~ s/\\$TWiki::TranslationToken/\"/go;  # resolve \"
    return $value;
}

# ---++ ObjectMethod get($key) -> $value
#
# | $key | Attribute to get |
# Get an attr value from the map.
#
# Synonymous with $attrs->{$key}. Retained mainly for compatibility with
# the old AttrsContrib.
sub get {
    my( $this, $field) = @_;
    return $this->{$field};
}

1;