lib/TWiki/Attrs.pm
changeset 0 414e01d06fd5
equal deleted inserted replaced
-1:000000000000 0:414e01d06fd5
       
     1 # Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/
       
     2 #
       
     3 # Copyright (C) 1999-2007 TWiki Contributors. All Rights Reserved.
       
     4 # TWiki Contributors are listed in the AUTHORS file in the root of
       
     5 # this distribution. NOTE: Please extend that file, not this notice.
       
     6 #
       
     7 # Additional copyrights apply to some or all of the code in this
       
     8 # file as follows:
       
     9 # Derived from Contrib::Attrs, which is
       
    10 # Copyright (C) 2001 Motorola - All rights reserved
       
    11 #
       
    12 # This program is free software; you can redistribute it and/or
       
    13 # modify it under the terms of the GNU General Public License
       
    14 # as published by the Free Software Foundation; either version 2
       
    15 # of the License, or (at your option) any later version. For
       
    16 # more details read LICENSE in the root of this distribution.
       
    17 #
       
    18 # This program is distributed in the hope that it will be useful,
       
    19 # but WITHOUT ANY WARRANTY; without even the implied warranty of
       
    20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
       
    21 #
       
    22 # As per the GPL, removal of this notice is prohibited.
       
    23 
       
    24 =pod
       
    25 
       
    26 ---+ package TWiki::Attrs
       
    27 
       
    28 Class of attribute sets, designed for parsing and storing attribute values
       
    29 from a TWiki tag e.g. =%<nop>TAG{"joe" fred="bad" joe="mad"}%=
       
    30 
       
    31 An attribute set is a hash containing an entry for each parameter. The
       
    32 default parameter (unnamed quoted string) is named <code>_<nop>DEFAULT</code> in the hash.
       
    33 
       
    34 Attributes declared later in the string will override those of the same
       
    35 name defined earlier. The one exception to this is the _DEFAULT key, where
       
    36 the _first_ instance is always taken.
       
    37 
       
    38 As well as the default TWiki syntax (parameter values double-quoted)
       
    39 this class also parses single-quoted values, unquoted spaceless
       
    40 values, spaces around the =, and commas as well as spaces separating values.
       
    41 The extended syntax has to be enabled by passing the =$friendly= parameter
       
    42 to =new=.
       
    43 
       
    44 =cut
       
    45 
       
    46 package TWiki::Attrs;
       
    47 
       
    48 use strict;
       
    49 use Assert;
       
    50 
       
    51 use vars qw( $ERRORKEY $DEFAULTKEY $RAWKEY );
       
    52 
       
    53 $ERRORKEY   = '_ERROR';
       
    54 $DEFAULTKEY = '_DEFAULT';
       
    55 $RAWKEY     = '_RAW';
       
    56 
       
    57 =pod
       
    58 
       
    59 ---++ ClassMethod new ($string, $friendly) => \%attrsObjectRef
       
    60 
       
    61    * =$string= - String containing attribute specification
       
    62    * =$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.
       
    63 
       
    64 Parse a standard attribute string containing name=value pairs and create a new
       
    65 attributes object. The value may be a word or a quoted string. If there is an
       
    66 error during parsing, the parse will complete but $attrs->{_ERROR} will be
       
    67 set in the new object. $attrs->{_RAW} will always contain the full unprocessed
       
    68 $string.
       
    69 
       
    70 Extended syntax example:
       
    71 <verbatim>
       
    72 my $attrs = new TWiki::Attrs('the="time \\"has come", "the walrus" said to=speak of=\'many \\'things\', 1);
       
    73 </verbatim>
       
    74 In this example:
       
    75    * =the= will be =time "has come=
       
    76    * <code>_<nop>_<nop>default__</code> will be =the walrus=
       
    77    * =said= will be =on=
       
    78    * =to= will be =speak=
       
    79    * =of= will be =many 'things=
       
    80 
       
    81 Only " and ' are escaped.
       
    82 
       
    83 Traditional syntax is as old TWiki, except that the whole string is parsed
       
    84 (the old parser would only recognise default values in position 1, nowhere
       
    85 else)
       
    86 
       
    87 =cut
       
    88 
       
    89 sub new {
       
    90     my ( $class, $string, $friendly ) = @_;
       
    91     my $this = bless( {}, $class );
       
    92 
       
    93     $this->{$RAWKEY} = $string;
       
    94 
       
    95     return $this unless defined( $string );
       
    96 
       
    97     $string =~ s/\\(["'])/$TWiki::TranslationToken.sprintf("%.2u", ord($1))/ge;  # escapes
       
    98 
       
    99     my $sep = ( $friendly ? "[\\s,]" : "\\s" );
       
   100     my $first = 1;
       
   101 
       
   102     if( !$friendly && $string =~ s/^\s*\"(.*?)\"\s*(\w+\s*=\s*\"|$)/$2/s ) {
       
   103         $this->{$DEFAULTKEY} = $1;
       
   104     }
       
   105     while ( $string =~ m/\S/s ) {
       
   106         # name="value" pairs
       
   107         if ( $string =~ s/^$sep*(\w+)\s*=\s*\"(.*?)\"//is ) {
       
   108             $this->{$1} = $2;
       
   109             $first = 0;
       
   110         }
       
   111         # simple double-quoted value with no name, sets the default
       
   112         elsif ( $string =~ s/^$sep*\"(.*?)\"//os ) {
       
   113             $this->{$DEFAULTKEY} = $1
       
   114               unless defined( $this->{$DEFAULTKEY} );
       
   115             $first = 0;
       
   116         }
       
   117         elsif ( $friendly ) {
       
   118             # name='value' pairs
       
   119             if ( $string =~ s/^$sep*(\w+)\s*=\s*'(.*?)'//is ) {
       
   120                 $this->{$1} = $2;
       
   121             }
       
   122             # name=value pairs
       
   123             elsif ( $string =~ s/^$sep*(\w+)\s*=\s*([^\s,\}\'\"]*)//is ) {
       
   124                 $this->{$1} = $2;
       
   125             }
       
   126             # simple single-quoted value with no name, sets the default
       
   127             elsif ( $string =~ s/^$sep*'(.*?)'//os ) {
       
   128                 $this->{$DEFAULTKEY} = $1
       
   129                   unless defined( $this->{$DEFAULTKEY} );
       
   130             }
       
   131             # simple name with no value (boolean, or _DEFAULT)
       
   132             elsif ( $string =~ s/^$sep*([a-z]\w*)\b//is ) {
       
   133                 my $key = $1;
       
   134                 $this->{$key} = 1;
       
   135             }
       
   136             # otherwise the whole string - sans padding - is the default
       
   137             else {
       
   138                 if( $string =~ m/^\s*(.*?)\s*$/s &&
       
   139                       !defined($this->{$DEFAULTKEY})) {
       
   140                     $this->{$DEFAULTKEY} = $1;
       
   141                 }
       
   142                 last;
       
   143             }
       
   144         } elsif( $string =~ m/^\s*(.*?)\s*$/s ) {
       
   145             $this->{$DEFAULTKEY} = $1 if( $first );
       
   146             last;
       
   147         }
       
   148     }
       
   149     foreach my $k ( keys %$this ) {
       
   150         $this->{$k} =~ s/$TWiki::TranslationToken(\d\d)/chr($1)/geo;  # escapes
       
   151     }
       
   152     return $this;
       
   153 }
       
   154 
       
   155 =pod
       
   156 
       
   157 ---++ ObjectMethod isEmpty() -> boolean
       
   158 
       
   159 Return false if attribute set is not empty.
       
   160 
       
   161 =cut
       
   162 
       
   163 sub isEmpty {
       
   164   my $this = shift;
       
   165 
       
   166 
       
   167   foreach my $k ( keys %$this ) {
       
   168       return 0 if $k ne $RAWKEY;
       
   169   }
       
   170   return 1;
       
   171 }
       
   172 
       
   173 =pod
       
   174 
       
   175 ---++ ObjectMethod remove($key) -> $value
       
   176 
       
   177    * =$key= - Attribute to remove
       
   178 Remove an attr value from the map, return old value. After a call to
       
   179 =remove= the attribute is no longer defined.
       
   180 
       
   181 =cut
       
   182 
       
   183 sub remove {
       
   184   my ( $this, $attr ) = @_;
       
   185   my $val = $this->{$attr};
       
   186   delete( $this->{$attr} ) if ( exists $this->{$attr} );
       
   187   return $val;
       
   188 }
       
   189 
       
   190 =pod
       
   191 
       
   192 ---++ ObjectMethod stringify() -> $string
       
   193 
       
   194 Generate a printed form for the map, using strict
       
   195 attribute syntax, with only the single-quote extension
       
   196 syntax observed (no {} brackets, though).
       
   197 
       
   198 =cut
       
   199 
       
   200 sub stringify {
       
   201   my $this = shift;
       
   202   my $key;
       
   203   my @ss;
       
   204   foreach $key ( sort keys %$this ) {
       
   205 	if ( $key ne $ERRORKEY && $key ne $RAWKEY ) {
       
   206 	  my $es = ( $key eq $DEFAULTKEY ) ? '' : $key.'=';
       
   207 	  my $val = $this->{$key};
       
   208       $val =~ s/"/\\"/g;
       
   209       push( @ss, $es.'"'.$val.'"' );
       
   210 	}
       
   211   }
       
   212   return join( ' ', @ss );
       
   213 }
       
   214 
       
   215 
       
   216 # ---++ StaticMethod extractValue() -> $string
       
   217 #
       
   218 # Legacy support, formerly known as extractNameValuePair. This
       
   219 # static method uses context information to determine how a value
       
   220 # string is to be parsed. For example, if you have an attribute string
       
   221 # like this:
       
   222 #
       
   223 # "abc def="ghi" jkl" def="qqq"
       
   224 #
       
   225 # then call extractValue( "def" ), it will return "ghi".
       
   226 
       
   227 sub extractValue {
       
   228     my( $str, $name ) = @_;
       
   229 
       
   230     my $value = '';
       
   231     return $value unless( $str );
       
   232     $str =~ s/\\\"/\\$TWiki::TranslationToken/g;  # escape \"
       
   233 
       
   234     if( $name ) {
       
   235         # format is: %VAR{ ... name = "value" }%
       
   236         if( $str =~ /(^|[^\S])$name\s*=\s*\"([^\"]*)\"/ ) {
       
   237             $value = $2 if defined $2;  # distinguish between '' and "0"
       
   238         }
       
   239 
       
   240     } else {
       
   241         # test if format: { "value" ... }
       
   242         if( $str =~ /(^|\=\s*\"[^\"]*\")\s*\"(.*?)\"\s*(\w+\s*=\s*\"|$)/ ) {
       
   243             # is: %VAR{ "value" }%
       
   244             # or: %VAR{ "value" param="etc" ... }%
       
   245             # or: %VAR{ ... = "..." "value" ... }%
       
   246             # Note: "value" may contain embedded double quotes
       
   247             $value = $2 if defined $2;  # distinguish between '' and "0";
       
   248 
       
   249         } elsif( ( $str =~ /^\s*\w+\s*=\s*\"([^\"]*)/ ) && ( $1 ) ) {
       
   250             # is: %VAR{ name = "value" }%
       
   251             # do nothing, is not a standalone var
       
   252 
       
   253         } else {
       
   254             # format is: %VAR{ value }%
       
   255             $value = $str;
       
   256         }
       
   257     }
       
   258     $value =~ s/\\$TWiki::TranslationToken/\"/go;  # resolve \"
       
   259     return $value;
       
   260 }
       
   261 
       
   262 # ---++ ObjectMethod get($key) -> $value
       
   263 #
       
   264 # | $key | Attribute to get |
       
   265 # Get an attr value from the map.
       
   266 #
       
   267 # Synonymous with $attrs->{$key}. Retained mainly for compatibility with
       
   268 # the old AttrsContrib.
       
   269 sub get {
       
   270     my( $this, $field) = @_;
       
   271     return $this->{$field};
       
   272 }
       
   273 
       
   274 1;