lib/TWiki/Attrs.pm
changeset 0 414e01d06fd5
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/lib/TWiki/Attrs.pm	Sat Jan 26 15:50:53 2008 +0100
     1.3 @@ -0,0 +1,274 @@
     1.4 +# Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/
     1.5 +#
     1.6 +# Copyright (C) 1999-2007 TWiki Contributors. All Rights Reserved.
     1.7 +# TWiki Contributors are listed in the AUTHORS file in the root of
     1.8 +# this distribution. NOTE: Please extend that file, not this notice.
     1.9 +#
    1.10 +# Additional copyrights apply to some or all of the code in this
    1.11 +# file as follows:
    1.12 +# Derived from Contrib::Attrs, which is
    1.13 +# Copyright (C) 2001 Motorola - All rights reserved
    1.14 +#
    1.15 +# This program is free software; you can redistribute it and/or
    1.16 +# modify it under the terms of the GNU General Public License
    1.17 +# as published by the Free Software Foundation; either version 2
    1.18 +# of the License, or (at your option) any later version. For
    1.19 +# more details read LICENSE in the root of this distribution.
    1.20 +#
    1.21 +# This program is distributed in the hope that it will be useful,
    1.22 +# but WITHOUT ANY WARRANTY; without even the implied warranty of
    1.23 +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
    1.24 +#
    1.25 +# As per the GPL, removal of this notice is prohibited.
    1.26 +
    1.27 +=pod
    1.28 +
    1.29 +---+ package TWiki::Attrs
    1.30 +
    1.31 +Class of attribute sets, designed for parsing and storing attribute values
    1.32 +from a TWiki tag e.g. =%<nop>TAG{"joe" fred="bad" joe="mad"}%=
    1.33 +
    1.34 +An attribute set is a hash containing an entry for each parameter. The
    1.35 +default parameter (unnamed quoted string) is named <code>_<nop>DEFAULT</code> in the hash.
    1.36 +
    1.37 +Attributes declared later in the string will override those of the same
    1.38 +name defined earlier. The one exception to this is the _DEFAULT key, where
    1.39 +the _first_ instance is always taken.
    1.40 +
    1.41 +As well as the default TWiki syntax (parameter values double-quoted)
    1.42 +this class also parses single-quoted values, unquoted spaceless
    1.43 +values, spaces around the =, and commas as well as spaces separating values.
    1.44 +The extended syntax has to be enabled by passing the =$friendly= parameter
    1.45 +to =new=.
    1.46 +
    1.47 +=cut
    1.48 +
    1.49 +package TWiki::Attrs;
    1.50 +
    1.51 +use strict;
    1.52 +use Assert;
    1.53 +
    1.54 +use vars qw( $ERRORKEY $DEFAULTKEY $RAWKEY );
    1.55 +
    1.56 +$ERRORKEY   = '_ERROR';
    1.57 +$DEFAULTKEY = '_DEFAULT';
    1.58 +$RAWKEY     = '_RAW';
    1.59 +
    1.60 +=pod
    1.61 +
    1.62 +---++ ClassMethod new ($string, $friendly) => \%attrsObjectRef
    1.63 +
    1.64 +   * =$string= - String containing attribute specification
    1.65 +   * =$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.
    1.66 +
    1.67 +Parse a standard attribute string containing name=value pairs and create a new
    1.68 +attributes object. The value may be a word or a quoted string. If there is an
    1.69 +error during parsing, the parse will complete but $attrs->{_ERROR} will be
    1.70 +set in the new object. $attrs->{_RAW} will always contain the full unprocessed
    1.71 +$string.
    1.72 +
    1.73 +Extended syntax example:
    1.74 +<verbatim>
    1.75 +my $attrs = new TWiki::Attrs('the="time \\"has come", "the walrus" said to=speak of=\'many \\'things\', 1);
    1.76 +</verbatim>
    1.77 +In this example:
    1.78 +   * =the= will be =time "has come=
    1.79 +   * <code>_<nop>_<nop>default__</code> will be =the walrus=
    1.80 +   * =said= will be =on=
    1.81 +   * =to= will be =speak=
    1.82 +   * =of= will be =many 'things=
    1.83 +
    1.84 +Only " and ' are escaped.
    1.85 +
    1.86 +Traditional syntax is as old TWiki, except that the whole string is parsed
    1.87 +(the old parser would only recognise default values in position 1, nowhere
    1.88 +else)
    1.89 +
    1.90 +=cut
    1.91 +
    1.92 +sub new {
    1.93 +    my ( $class, $string, $friendly ) = @_;
    1.94 +    my $this = bless( {}, $class );
    1.95 +
    1.96 +    $this->{$RAWKEY} = $string;
    1.97 +
    1.98 +    return $this unless defined( $string );
    1.99 +
   1.100 +    $string =~ s/\\(["'])/$TWiki::TranslationToken.sprintf("%.2u", ord($1))/ge;  # escapes
   1.101 +
   1.102 +    my $sep = ( $friendly ? "[\\s,]" : "\\s" );
   1.103 +    my $first = 1;
   1.104 +
   1.105 +    if( !$friendly && $string =~ s/^\s*\"(.*?)\"\s*(\w+\s*=\s*\"|$)/$2/s ) {
   1.106 +        $this->{$DEFAULTKEY} = $1;
   1.107 +    }
   1.108 +    while ( $string =~ m/\S/s ) {
   1.109 +        # name="value" pairs
   1.110 +        if ( $string =~ s/^$sep*(\w+)\s*=\s*\"(.*?)\"//is ) {
   1.111 +            $this->{$1} = $2;
   1.112 +            $first = 0;
   1.113 +        }
   1.114 +        # simple double-quoted value with no name, sets the default
   1.115 +        elsif ( $string =~ s/^$sep*\"(.*?)\"//os ) {
   1.116 +            $this->{$DEFAULTKEY} = $1
   1.117 +              unless defined( $this->{$DEFAULTKEY} );
   1.118 +            $first = 0;
   1.119 +        }
   1.120 +        elsif ( $friendly ) {
   1.121 +            # name='value' pairs
   1.122 +            if ( $string =~ s/^$sep*(\w+)\s*=\s*'(.*?)'//is ) {
   1.123 +                $this->{$1} = $2;
   1.124 +            }
   1.125 +            # name=value pairs
   1.126 +            elsif ( $string =~ s/^$sep*(\w+)\s*=\s*([^\s,\}\'\"]*)//is ) {
   1.127 +                $this->{$1} = $2;
   1.128 +            }
   1.129 +            # simple single-quoted value with no name, sets the default
   1.130 +            elsif ( $string =~ s/^$sep*'(.*?)'//os ) {
   1.131 +                $this->{$DEFAULTKEY} = $1
   1.132 +                  unless defined( $this->{$DEFAULTKEY} );
   1.133 +            }
   1.134 +            # simple name with no value (boolean, or _DEFAULT)
   1.135 +            elsif ( $string =~ s/^$sep*([a-z]\w*)\b//is ) {
   1.136 +                my $key = $1;
   1.137 +                $this->{$key} = 1;
   1.138 +            }
   1.139 +            # otherwise the whole string - sans padding - is the default
   1.140 +            else {
   1.141 +                if( $string =~ m/^\s*(.*?)\s*$/s &&
   1.142 +                      !defined($this->{$DEFAULTKEY})) {
   1.143 +                    $this->{$DEFAULTKEY} = $1;
   1.144 +                }
   1.145 +                last;
   1.146 +            }
   1.147 +        } elsif( $string =~ m/^\s*(.*?)\s*$/s ) {
   1.148 +            $this->{$DEFAULTKEY} = $1 if( $first );
   1.149 +            last;
   1.150 +        }
   1.151 +    }
   1.152 +    foreach my $k ( keys %$this ) {
   1.153 +        $this->{$k} =~ s/$TWiki::TranslationToken(\d\d)/chr($1)/geo;  # escapes
   1.154 +    }
   1.155 +    return $this;
   1.156 +}
   1.157 +
   1.158 +=pod
   1.159 +
   1.160 +---++ ObjectMethod isEmpty() -> boolean
   1.161 +
   1.162 +Return false if attribute set is not empty.
   1.163 +
   1.164 +=cut
   1.165 +
   1.166 +sub isEmpty {
   1.167 +  my $this = shift;
   1.168 +
   1.169 +
   1.170 +  foreach my $k ( keys %$this ) {
   1.171 +      return 0 if $k ne $RAWKEY;
   1.172 +  }
   1.173 +  return 1;
   1.174 +}
   1.175 +
   1.176 +=pod
   1.177 +
   1.178 +---++ ObjectMethod remove($key) -> $value
   1.179 +
   1.180 +   * =$key= - Attribute to remove
   1.181 +Remove an attr value from the map, return old value. After a call to
   1.182 +=remove= the attribute is no longer defined.
   1.183 +
   1.184 +=cut
   1.185 +
   1.186 +sub remove {
   1.187 +  my ( $this, $attr ) = @_;
   1.188 +  my $val = $this->{$attr};
   1.189 +  delete( $this->{$attr} ) if ( exists $this->{$attr} );
   1.190 +  return $val;
   1.191 +}
   1.192 +
   1.193 +=pod
   1.194 +
   1.195 +---++ ObjectMethod stringify() -> $string
   1.196 +
   1.197 +Generate a printed form for the map, using strict
   1.198 +attribute syntax, with only the single-quote extension
   1.199 +syntax observed (no {} brackets, though).
   1.200 +
   1.201 +=cut
   1.202 +
   1.203 +sub stringify {
   1.204 +  my $this = shift;
   1.205 +  my $key;
   1.206 +  my @ss;
   1.207 +  foreach $key ( sort keys %$this ) {
   1.208 +	if ( $key ne $ERRORKEY && $key ne $RAWKEY ) {
   1.209 +	  my $es = ( $key eq $DEFAULTKEY ) ? '' : $key.'=';
   1.210 +	  my $val = $this->{$key};
   1.211 +      $val =~ s/"/\\"/g;
   1.212 +      push( @ss, $es.'"'.$val.'"' );
   1.213 +	}
   1.214 +  }
   1.215 +  return join( ' ', @ss );
   1.216 +}
   1.217 +
   1.218 +
   1.219 +# ---++ StaticMethod extractValue() -> $string
   1.220 +#
   1.221 +# Legacy support, formerly known as extractNameValuePair. This
   1.222 +# static method uses context information to determine how a value
   1.223 +# string is to be parsed. For example, if you have an attribute string
   1.224 +# like this:
   1.225 +#
   1.226 +# "abc def="ghi" jkl" def="qqq"
   1.227 +#
   1.228 +# then call extractValue( "def" ), it will return "ghi".
   1.229 +
   1.230 +sub extractValue {
   1.231 +    my( $str, $name ) = @_;
   1.232 +
   1.233 +    my $value = '';
   1.234 +    return $value unless( $str );
   1.235 +    $str =~ s/\\\"/\\$TWiki::TranslationToken/g;  # escape \"
   1.236 +
   1.237 +    if( $name ) {
   1.238 +        # format is: %VAR{ ... name = "value" }%
   1.239 +        if( $str =~ /(^|[^\S])$name\s*=\s*\"([^\"]*)\"/ ) {
   1.240 +            $value = $2 if defined $2;  # distinguish between '' and "0"
   1.241 +        }
   1.242 +
   1.243 +    } else {
   1.244 +        # test if format: { "value" ... }
   1.245 +        if( $str =~ /(^|\=\s*\"[^\"]*\")\s*\"(.*?)\"\s*(\w+\s*=\s*\"|$)/ ) {
   1.246 +            # is: %VAR{ "value" }%
   1.247 +            # or: %VAR{ "value" param="etc" ... }%
   1.248 +            # or: %VAR{ ... = "..." "value" ... }%
   1.249 +            # Note: "value" may contain embedded double quotes
   1.250 +            $value = $2 if defined $2;  # distinguish between '' and "0";
   1.251 +
   1.252 +        } elsif( ( $str =~ /^\s*\w+\s*=\s*\"([^\"]*)/ ) && ( $1 ) ) {
   1.253 +            # is: %VAR{ name = "value" }%
   1.254 +            # do nothing, is not a standalone var
   1.255 +
   1.256 +        } else {
   1.257 +            # format is: %VAR{ value }%
   1.258 +            $value = $str;
   1.259 +        }
   1.260 +    }
   1.261 +    $value =~ s/\\$TWiki::TranslationToken/\"/go;  # resolve \"
   1.262 +    return $value;
   1.263 +}
   1.264 +
   1.265 +# ---++ ObjectMethod get($key) -> $value
   1.266 +#
   1.267 +# | $key | Attribute to get |
   1.268 +# Get an attr value from the map.
   1.269 +#
   1.270 +# Synonymous with $attrs->{$key}. Retained mainly for compatibility with
   1.271 +# the old AttrsContrib.
   1.272 +sub get {
   1.273 +    my( $this, $field) = @_;
   1.274 +    return $this->{$field};
   1.275 +}
   1.276 +
   1.277 +1;