# Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/

#

# Copyright (C) 1999-2007 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 2

# 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;