lib/TWiki/Meta.pm
changeset 0 414e01d06fd5
child 1 e2915a7cbdfa
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/lib/TWiki/Meta.pm	Sat Jan 26 15:50:53 2008 +0100
     1.3 @@ -0,0 +1,810 @@
     1.4 +# See bottom of file for license and copyright information
     1.5 +
     1.6 +=pod
     1.7 +
     1.8 +---+ package TWiki::Meta
     1.9 +
    1.10 +All TWiki topics have *data* (text) and *meta-data* (information about the
    1.11 +topic). Meta-data includes information such as file attachments, form fields,
    1.12 +topic parentage etc. When TWiki loads a topic from the store, it represents
    1.13 +the meta-data in the topic using an object of this class.
    1.14 +
    1.15 +A meta-data object is a hash of different types of meta-data (keyed on
    1.16 +the type, such as 'FIELD' and 'TOPICINFO').
    1.17 +
    1.18 +Each entry in the hash is an array, where each entry in the array
    1.19 +contains another hash of the key=value pairs, corresponding to a
    1.20 +single meta-datum.
    1.21 +
    1.22 +If there may be multiple entries of the same top-level type (i.e. for FIELD
    1.23 +and FILEATTACHMENT) then the array has multiple entries. These types
    1.24 +are referred to as "keyed" types. The array entries are keyed with the
    1.25 +attribute 'name' which must be in each entry in the array.
    1.26 +
    1.27 +For unkeyed types, the array has only one entry.
    1.28 +
    1.29 +Pictorially,
    1.30 +   * TOPICINFO
    1.31 +      * author => '...'
    1.32 +      * date => '...'
    1.33 +      * ...
    1.34 +   * FILEATTACHMENT
    1.35 +      * [0] -> { name => '...' ... }
    1.36 +      * [1] -> { name => '...' ... }
    1.37 +   * FIELD
    1.38 +      * [0] -> { name => '...' ... }
    1.39 +      * [1] -> { name => '...' ... }
    1.40 +
    1.41 +As well as the meta-data, the object also stores the web name, topic
    1.42 +name and remaining text after meta-data extraction.
    1.43 +
    1.44 +=cut
    1.45 +
    1.46 +package TWiki::Meta;
    1.47 +
    1.48 +use strict;
    1.49 +use Error qw(:try);
    1.50 +use Assert;
    1.51 +
    1.52 +=pod
    1.53 +
    1.54 +---++ ClassMethod new($session, $web, $topic, $text)
    1.55 +   * =$session= - a TWiki object (e.g. =$TWiki::Plugins::SESSION)
    1.56 +   * =$web=, =$topic= - the topic that the metadata relates to
    1.57 +Construct a new, empty object to contain meta-data for the given topic.
    1.58 +   * $text - optional raw text to convert to meta-data form
    1.59 +=cut
    1.60 +
    1.61 +sub new {
    1.62 +    my ( $class, $session, $web, $topic, $text ) = @_;
    1.63 +    my $this = bless( { _session => $session }, $class );
    1.64 +
    1.65 +    # Note: internal fields are prepended with _. All uppercase
    1.66 +    # fields will be assumed to be meta-data.
    1.67 +
    1.68 +    ASSERT($web) if DEBUG;
    1.69 +    ASSERT($topic) if DEBUG;
    1.70 +
    1.71 +    $this->{_web} = $web;
    1.72 +    $this->{_topic} = $topic;
    1.73 +    $this->{_text} = '';
    1.74 +
    1.75 +    $this->{FILEATTACHMENT} = [];
    1.76 +
    1.77 +    if (defined $text) {
    1.78 +        $session->{store}->extractMetaData($this, $text);
    1.79 +    }
    1.80 +
    1.81 +    return $this;
    1.82 +}
    1.83 +
    1.84 +=begin twiki
    1.85 +
    1.86 +---++ ObjectMethod finish()
    1.87 +Break circular references.
    1.88 +
    1.89 +=cut
    1.90 +
    1.91 +# Note to developers; please undef *all* fields in the object explicitly,
    1.92 +# whether they are references or not. That way this method is "golden
    1.93 +# documentation" of the live fields in the object.
    1.94 +sub finish {
    1.95 +    my $this = shift;
    1.96 +    undef $this->{_web};
    1.97 +    undef $this->{_topic};
    1.98 +    undef $this->{_text};
    1.99 +    undef $this->{_session};
   1.100 +}
   1.101 +
   1.102 +=pod
   1.103 +
   1.104 +---++ ObjectMethod session()
   1.105 +
   1.106 +Get the session
   1.107 +
   1.108 +=cut
   1.109 +
   1.110 +sub session {
   1.111 +    return $_[0]->{_session};
   1.112 +}
   1.113 +
   1.114 +=pod
   1.115 +
   1.116 +---++ ObjectMethod web()
   1.117 +
   1.118 +Get the web name
   1.119 +
   1.120 +=cut
   1.121 +
   1.122 +sub web {
   1.123 +    return $_[0]->{_web};
   1.124 +}
   1.125 +
   1.126 +=pod
   1.127 +
   1.128 +---++ ObjectMethod topic()
   1.129 +
   1.130 +Get the topic name
   1.131 +
   1.132 +=cut
   1.133 +
   1.134 +sub topic {
   1.135 +    return $_[0]->{_topic};
   1.136 +}
   1.137 +
   1.138 +=pod
   1.139 +
   1.140 +---++ ObjectMethod text([$text]) -> $text
   1.141 +
   1.142 +Get/set the topic body text. If $text is undef, gets the value, if it is
   1.143 +defined, sets the value to that and returns the new text.
   1.144 +
   1.145 +=cut
   1.146 +
   1.147 +sub text {
   1.148 +    my ($this, $val) = @_;
   1.149 +    if (defined($val)) {
   1.150 +        $this->{_text} = $val;
   1.151 +    }
   1.152 +    return $this->{_text};
   1.153 +}
   1.154 +
   1.155 +=pod
   1.156 +
   1.157 +---++ ObjectMethod put($type, \%args)
   1.158 +
   1.159 +Put a hash of key=value pairs into the given type set in this meta. This
   1.160 +will *not* replace another value with the same name (for that see =putKeyed=)
   1.161 +
   1.162 +For example, 
   1.163 +<verbatim>
   1.164 +$meta->put( 'FIELD', { name => 'MaxAge', title => 'Max Age', value =>'103' } );
   1.165 +</verbatim>
   1.166 +
   1.167 +=cut
   1.168 +
   1.169 +sub put {
   1.170 +    my( $this, $type, $args ) = @_;
   1.171 +
   1.172 +    my $data = $this->{$type};
   1.173 +    if( $data ) {
   1.174 +        # overwrite old single value
   1.175 +        $data->[0] = $args;
   1.176 +    } else {
   1.177 +        push( @{$this->{$type}}, $args );
   1.178 +    }
   1.179 +}
   1.180 +
   1.181 +=pod
   1.182 +
   1.183 +---++ ObjectMethod putKeyed($type, \%args)
   1.184 +
   1.185 +Put a hash of key=value pairs into the given type set in this meta, replacing
   1.186 +any existing value with the same key.
   1.187 +
   1.188 +For example,
   1.189 +<verbatim>
   1.190 +$meta->putKeyed( 'FIELD', { name => 'MaxAge', title => 'Max Age', value =>'103' } );
   1.191 +</verbatim>
   1.192 +
   1.193 +=cut
   1.194 +
   1.195 +# Note: Array is used instead of a hash to preserve sequence
   1.196 +
   1.197 +sub putKeyed {
   1.198 +    my( $this, $type, $args ) = @_;
   1.199 +
   1.200 +    my $data = $this->{$type};
   1.201 +    if( $data ) {
   1.202 +        my $keyName = $args->{name};
   1.203 +        ASSERT( $keyName ) if DEBUG;
   1.204 +        my $i = scalar( @$data );
   1.205 +        while( $keyName && $i-- ) {
   1.206 +            if( $data->[$i]->{name} eq $keyName ) {
   1.207 +                $data->[$i] = $args;
   1.208 +                return;
   1.209 +            }
   1.210 +        }
   1.211 +        push @$data, $args;
   1.212 +    } else {
   1.213 +      push( @{$this->{$type}}, $args );
   1.214 +    }
   1.215 +}
   1.216 +
   1.217 +=pod
   1.218 +
   1.219 +---++ ObjectMethod putAll
   1.220 +
   1.221 +Replaces all the items of a given key with a new array.
   1.222 +
   1.223 +For example,
   1.224 +<verbatim>
   1.225 +$meta->putAll( 'FIELD',
   1.226 +     { name => 'MinAge', title => 'Min Age', value =>'50' },
   1.227 +     { name => 'MaxAge', title => 'Max Age', value =>'103' },
   1.228 +     { name => 'HairColour', title => 'Hair Colour', value =>'white' }
   1.229 + );
   1.230 +</verbatim>
   1.231 +
   1.232 +=cut
   1.233 +
   1.234 +sub putAll {
   1.235 +    my( $this, $type, @array ) = @_;
   1.236 +
   1.237 +    $this->{$type} = \@array;
   1.238 +}
   1.239 +
   1.240 +=pod
   1.241 +
   1.242 +---++ ObjectMethod get( $type, $key ) -> \%hash
   1.243 +
   1.244 +Find the value of a meta-datum in the map. If the type is
   1.245 +keyed (idenitifed by a =name=), the =$key= parameter is required
   1.246 +to say _which_ entry you want. Otherwise you will just get the first value.
   1.247 +
   1.248 +If you want all the keys of a given type use the 'find' method.
   1.249 +
   1.250 +The result is a reference to the hash for the item.
   1.251 +
   1.252 +For example,
   1.253 +<verbatim>
   1.254 +my $ma = $meta->get( 'FIELD', 'MinAge' );
   1.255 +my $topicinfo = $meta->get( 'TOPICINFO' ); # get the TOPICINFO hash
   1.256 +</verbatim>
   1.257 +
   1.258 +=cut
   1.259 +
   1.260 +sub get {
   1.261 +    my( $this, $type, $keyValue ) = @_;
   1.262 +
   1.263 +    my $data = $this->{$type};
   1.264 +    if( $data ) {
   1.265 +        if( defined $keyValue ) {
   1.266 +            foreach my $item ( @$data ) {
   1.267 +                return $item if( $item->{name} eq $keyValue );
   1.268 +            }
   1.269 +        } else {
   1.270 +            return $data->[0];
   1.271 +        }
   1.272 +    }
   1.273 +
   1.274 +    return undef;
   1.275 +}
   1.276 +
   1.277 +=pod
   1.278 +
   1.279 +---++ ObjectMethod find (  $type  ) -> @values
   1.280 +
   1.281 +Get all meta data for a specific type.
   1.282 +Returns the array stored for the type. This will be zero length
   1.283 +if there are no entries.
   1.284 +
   1.285 +For example,
   1.286 +<verbatim>
   1.287 +my $attachments = $meta->find( 'FILEATTACHMENT' );
   1.288 +</verbatim>
   1.289 +
   1.290 +=cut
   1.291 +
   1.292 +sub find {
   1.293 +    my( $this, $type ) = @_;
   1.294 +
   1.295 +    my $itemsr = $this->{$type};
   1.296 +    my @items = ();
   1.297 +
   1.298 +    if( $itemsr ) {
   1.299 +        @items = @$itemsr;
   1.300 +    }
   1.301 +
   1.302 +    return @items;
   1.303 +}
   1.304 +
   1.305 +=pod
   1.306 +
   1.307 +---++ ObjectMethod remove($type, $key)
   1.308 +
   1.309 +With no type, will remove all the contents of the object.
   1.310 +
   1.311 +With a $type but no $key, will remove _all_ items of that type (so for example if $type were FILEATTACHMENT it would remove all of them)
   1.312 +
   1.313 +With a $type and a $key it will remove only the specific item.
   1.314 +
   1.315 +=cut
   1.316 +
   1.317 +sub remove {
   1.318 +    my( $this, $type, $keyValue ) = @_;
   1.319 +
   1.320 +    if( $keyValue ) {
   1.321 +       my $data = $this->{$type};
   1.322 +       my @newData = ();
   1.323 +       foreach my $item ( @$data ) {
   1.324 +           if( $item->{name} ne $keyValue ) {
   1.325 +               push @newData, $item;
   1.326 +           }
   1.327 +       }
   1.328 +       $this->{$type} = \@newData;
   1.329 +    } elsif( $type ) {
   1.330 +       delete $this->{$type};
   1.331 +    } else {
   1.332 +        foreach my $entry ( keys %$this ) {
   1.333 +            unless( $entry =~ /^_/ ) {
   1.334 +                $this->remove( $entry );
   1.335 +            }
   1.336 +        }
   1.337 +    }
   1.338 +}
   1.339 +
   1.340 +=pod
   1.341 +
   1.342 +---++ ObjectMethod copyFrom( $otherMeta, $type, $nameFilter )
   1.343 +
   1.344 +Copy all entries of a type from another meta data set. This
   1.345 +will destroy the old values for that type, unless the
   1.346 +copied object doesn't contain entries for that type, in which
   1.347 +case it will retain the old values.
   1.348 +
   1.349 +If $type is undef, will copy ALL TYPES.
   1.350 +
   1.351 +If $nameFilter is defined (a perl refular expression), it will copy
   1.352 +only data where ={name}= matches $nameFilter.
   1.353 +
   1.354 +Does *not* copy web, topic or text.
   1.355 +
   1.356 +=cut
   1.357 +
   1.358 +sub copyFrom {
   1.359 +    my( $this, $otherMeta, $type, $filter ) = @_;
   1.360 +    ASSERT($otherMeta->isa( 'TWiki::Meta')) if DEBUG;
   1.361 +
   1.362 +    if( $type ) {
   1.363 +        foreach my $item ( @{$otherMeta->{$type}} ) {
   1.364 +            if( !$filter || ( $item->{name} && $item->{name} =~ /$filter/ )) {
   1.365 +                my %data = map { $_ => $item->{$_} } keys %$item;
   1.366 +                push( @{$this->{$type}}, \%data );
   1.367 +            }
   1.368 +        }
   1.369 +    } else {
   1.370 +        foreach my $k ( keys %$otherMeta ) {
   1.371 +            # Don't copy the web and topic fields, this may be a new topic
   1.372 +            unless( $k =~ /^_/ ) {
   1.373 +                $this->copyFrom( $otherMeta, $k );
   1.374 +            }
   1.375 +        }
   1.376 +    }
   1.377 +}
   1.378 +
   1.379 +=pod
   1.380 +
   1.381 +---++ ObjectMethod count($type) -> $integer
   1.382 +
   1.383 +Return the number of entries of the given type
   1.384 +
   1.385 +=cut
   1.386 +
   1.387 +sub count {
   1.388 +    my( $this, $type ) = @_;
   1.389 +    my $data = $this->{$type};
   1.390 +
   1.391 +    return scalar @$data if( defined( $data ));
   1.392 +
   1.393 +    return 0;
   1.394 +}
   1.395 +
   1.396 +=pod
   1.397 +
   1.398 +---++ ObjectMethod getRevisionInfo($fromrev) -> ( $date, $author, $rev, $comment )
   1.399 +
   1.400 +Try and get revision info from the meta information, or, if it is not
   1.401 +present, kick down to the Store module for the same information.
   1.402 +
   1.403 +Returns ( $revDate, $author, $rev, $comment )
   1.404 +
   1.405 +$rev is an integer revision number.
   1.406 +
   1.407 +=cut
   1.408 +
   1.409 +sub getRevisionInfo {
   1.410 +    my( $this, $fromrev ) = @_;
   1.411 +    my $store = $this->{_session}->{store};
   1.412 +
   1.413 +    my $topicinfo = $this->get( 'TOPICINFO' );
   1.414 +
   1.415 +    my( $date, $author, $rev, $comment );
   1.416 +    if( $topicinfo ) {
   1.417 +        $date = $topicinfo->{date} ;
   1.418 +        $author = $topicinfo->{author};
   1.419 +        $rev = $topicinfo->{version};
   1.420 +        $rev =~ s/^\$Rev(:\s*\d+)?\s*\$$/0/; # parse out SVN keywords in doc
   1.421 +        $rev =~ s/^\d+\.//;
   1.422 +        $comment = '';
   1.423 +        if ( !$fromrev || $rev eq $fromrev ) {
   1.424 +            return( $date, $author, $rev, $comment );
   1.425 +        }
   1.426 +    }
   1.427 +    # Different rev, or no topic info, delegate to Store
   1.428 +    ( $date, $author, $rev, $comment ) =
   1.429 +      $store->getRevisionInfo( $this->{_web}, $this->{_topic}, $fromrev );
   1.430 +    return( $date, $author, $rev, $comment );
   1.431 +}
   1.432 +
   1.433 +=pod
   1.434 +
   1.435 +---++ ObjectMethod merge( $otherMeta, $formDef )
   1.436 +
   1.437 +   * =$otherMeta= - a block of meta-data to merge with $this
   1.438 +   * =$formDef= reference to a TWiki::Form that gives the types of the fields in $this
   1.439 +
   1.440 +Merge the data in the other meta block.
   1.441 +   * File attachments that only appear in one set are preserved.
   1.442 +   * Form fields that only appear in one set are preserved.
   1.443 +   * Form field values that are different in each set are text-merged
   1.444 +   * We don't merge for field attributes or title
   1.445 +   * Topic info is not touched
   1.446 +   * The =mergeable= method on the form def is used to determine if that fields is mergeable. if it isn't, the value currently in meta will _not_ be changed.
   1.447 +
   1.448 +=cut
   1.449 +
   1.450 +sub merge {
   1.451 +    my ( $this, $other, $formDef ) = @_;
   1.452 +
   1.453 +    my $data = $other->{FIELD};
   1.454 +    if( $data ) {
   1.455 +        foreach my $otherD ( @$data ) {
   1.456 +            my $thisD = $this->get( 'FIELD', $otherD->{name} );
   1.457 +            if ( $thisD && $thisD->{value} ne $otherD->{value} ) {
   1.458 +                if( $formDef->isTextMergeable( $thisD->{name} )) {
   1.459 +                    require TWiki::Merge;
   1.460 +                    my $merged = TWiki::Merge::merge2(
   1.461 +                        'A', $otherD->{value}, 'B', $thisD->{value},
   1.462 +                        '.*?\s+',
   1.463 +                        $this->{_session},
   1.464 +                        $formDef->getField( $thisD->{name} ) );
   1.465 +                    # SMELL: we don't merge attributes or title
   1.466 +                    $thisD->{value} = $merged;
   1.467 +                }
   1.468 +            } elsif ( !$thisD ) {
   1.469 +                $this->putKeyed('FIELD', $otherD );
   1.470 +            }
   1.471 +        }
   1.472 +    }
   1.473 +
   1.474 +    $data = $other->{FILEATTACHMENT};
   1.475 +    if( $data ) {
   1.476 +        foreach my $otherD ( @$data ) {
   1.477 +            my $thisD = $this->get( 'FILEATTACHMENT', $otherD->{name} );
   1.478 +            if ( !$thisD ) {
   1.479 +                $this->putKeyed('FILEATTACHMENT', $otherD );
   1.480 +            }
   1.481 +        }
   1.482 +    }
   1.483 +}
   1.484 +
   1.485 +=pod
   1.486 +
   1.487 +---++ ObjectMethod stringify( $types ) -> $string
   1.488 +
   1.489 +Return a string version of the meta object. Uses \n to separate lines.
   1.490 +If =$types= is specified, return only types
   1.491 +that match it. Types should be a perl regular expression.
   1.492 +
   1.493 +=cut
   1.494 +
   1.495 +sub stringify {
   1.496 +    my( $this, $types ) = @_;
   1.497 +    my $s = '';
   1.498 +    $types ||= qr/^[A-Z]+$/;
   1.499 +
   1.500 +    foreach my $type ( grep { /$types/ } keys %$this ) {
   1.501 +        foreach my $item ( @{$this->{$type}} ) {
   1.502 +            $s .= "$type: " .
   1.503 +              join(' ', map{ "$_='".($item->{$_}||'')."'" }
   1.504 +                     sort keys %$item ) .
   1.505 +                       "\n";
   1.506 +        }
   1.507 +    }
   1.508 +    return $s;
   1.509 +}
   1.510 +
   1.511 +=pod
   1.512 +
   1.513 +---++ ObjectMethod forEachSelectedValue( $types, $keys, \&fn, \%options )
   1.514 +
   1.515 +Iterate over the values selected by the regular expressions in $types and
   1.516 +$keys.
   1.517 +   * =$types= - regular expression matching the names of fields to be processed. Will default to qr/^[A-Z]+$/ if undef.
   1.518 +   * =$keys= - regular expression matching the names of keys to be processed.  Will default to qr/^[a-z]+$/ if undef.
   1.519 +
   1.520 +Iterates over each value, calling =\&fn= on each, and replacing the value
   1.521 +with the result of \&fn.
   1.522 +
   1.523 +\%options will be passed on to $fn, with the following additions:
   1.524 +   * =_type= => the type name (e.g. "FILEATTACHMENT")
   1.525 +   * =_key= => the key name (e.g. "user")
   1.526 +
   1.527 +=cut
   1.528 +
   1.529 +sub forEachSelectedValue {
   1.530 +    my( $this, $types, $keys, $fn, $options ) = @_;
   1.531 +
   1.532 +    $types ||= qr/^[A-Z]+$/;
   1.533 +    $keys ||= qr/^[a-z]+$/;
   1.534 +
   1.535 +    foreach my $type ( grep { /$types/ } keys %$this ) {
   1.536 +        $options->{_type} = $type;
   1.537 +        my $data = $this->{$type};
   1.538 +        next unless $data;
   1.539 +        foreach my $datum ( @$data ) {
   1.540 +            foreach my $key ( grep { /$keys/ } keys %$datum ) {
   1.541 +                $options->{_key} = $key;
   1.542 +                $datum->{$key} = &$fn( $datum->{$key}, $options );
   1.543 +            }
   1.544 +        }
   1.545 +    }
   1.546 +}
   1.547 +
   1.548 +=pod
   1.549 +
   1.550 +---++ ObjectMethod getParent() -> $parent
   1.551 +
   1.552 +Gets the TOPICPARENT name.
   1.553 +
   1.554 +=cut
   1.555 +
   1.556 +sub getParent {
   1.557 +    my( $this ) = @_;
   1.558 +
   1.559 +    my $value = '';
   1.560 +    my $parent = $this->get( 'TOPICPARENT' );
   1.561 +    $value = $parent->{name} if( $parent );
   1.562 +    # Return empty string (not undef), if TOPICPARENT meta is broken
   1.563 +    $value = '' if (!defined $value);
   1.564 +    return $value;
   1.565 +}
   1.566 +
   1.567 +=pod
   1.568 +
   1.569 +---++ ObjectMethod getFormName() -> $formname
   1.570 +
   1.571 +Returns the name of the FORM, or '' if none.
   1.572 +
   1.573 +=cut
   1.574 +
   1.575 +sub getFormName {
   1.576 +    my( $this ) = @_;
   1.577 +
   1.578 +    my $aForm = $this->get( 'FORM' );
   1.579 +    if( $aForm ) {
   1.580 +        return $aForm->{name};
   1.581 +    }
   1.582 +    return '';
   1.583 +}
   1.584 +
   1.585 +=pod
   1.586 +
   1.587 +---++ ObjectMethod renderFormForDisplay() -> $html
   1.588 +
   1.589 +Render the form contained in the meta for display.
   1.590 +
   1.591 +=cut
   1.592 +
   1.593 +sub renderFormForDisplay {
   1.594 +    my $this = shift;
   1.595 +
   1.596 +    my $fname = $this->getFormName();
   1.597 +
   1.598 +    require TWiki::Form;
   1.599 +    return '' unless $fname;
   1.600 +
   1.601 +    my $form = new TWiki::Form( $this->{_session}, $this->{_web}, $fname );
   1.602 +
   1.603 +    if( $form ) {
   1.604 +        return $form->renderForDisplay( $this );
   1.605 +    } else {
   1.606 +        return CGI::span({class => 'twikiAlert'},
   1.607 +                         "Form definition '$fname' not found");
   1.608 +    }
   1.609 +}
   1.610 +
   1.611 +=pod
   1.612 +
   1.613 +---++ ObjectMethod renderFormFieldForDisplay($name, $format, $attrs) -> $text
   1.614 +
   1.615 +Render a single formfield, using the $format. See
   1.616 +TWiki::Form::FormField::renderForDisplay for a description of how the value
   1.617 +is rendered.
   1.618 +
   1.619 +=cut
   1.620 +
   1.621 +sub renderFormFieldForDisplay {
   1.622 +    my( $this, $name, $format, $attrs ) = @_;
   1.623 +
   1.624 +    my $value;
   1.625 +    my $mf = $this->get( 'FIELD', $name );
   1.626 +    unless( $mf ) {
   1.627 +        # Not a valid field name, maybe it's a title.
   1.628 +        require TWiki::Form;
   1.629 +        $name = TWiki::Form::fieldTitle2FieldName( $name );
   1.630 +        $mf = $this->get( 'FIELD', $name);
   1.631 +    }
   1.632 +    return '' unless $mf; # field not found
   1.633 +
   1.634 +    $value = $mf->{value};
   1.635 +
   1.636 +    my $fname = $this->getFormName();
   1.637 +    if( $fname ) {
   1.638 +        require TWiki::Form;
   1.639 +        my $form = new TWiki::Form( $this->{_session}, $this->{_web}, $fname );
   1.640 +        if( $form ) {
   1.641 +            my $field = $form->getField( $name );
   1.642 +            if( $field ) {
   1.643 +                return $field->renderForDisplay( $format, $value, $attrs );
   1.644 +            }
   1.645 +        }
   1.646 +    }
   1.647 +    # Form or field wasn't found, do your best!
   1.648 +    my $f = $this->get( 'FIELD', $name );
   1.649 +    if( $f ) {
   1.650 +        $format =~ s/\$title/$f->{title}/;
   1.651 +        require TWiki::Render;
   1.652 +        $value = TWiki::Render::protectFormFieldValue( $value, $attrs );
   1.653 +        $format =~ s/\$value/$value/;
   1.654 +    }
   1.655 +    return $format;
   1.656 +}
   1.657 +
   1.658 +=pod
   1.659 +
   1.660 +---++ ObjectMethod getEmbeddedStoreForm() -> $text
   1.661 +
   1.662 +Generate the embedded store form of the topic. The embedded store
   1.663 +form has meta-data values embedded using %META: lines. The text
   1.664 +stored in the meta is taken as the topic text.
   1.665 +
   1.666 +=cut
   1.667 +
   1.668 +sub getEmbeddedStoreForm {
   1.669 +    my $this = shift;
   1.670 +    $this->{_text} ||= '';
   1.671 +
   1.672 +    require TWiki::Store;
   1.673 +
   1.674 +    my $start = $this->_writeTypes( qw/TOPICINFO TOPICPARENT/ );
   1.675 +    my $end = $this->_writeTypes( qw/FORM FIELD FILEATTACHMENT TOPICMOVED/ );
   1.676 +    # append remaining meta data
   1.677 +    $end .= $this->_writeTypes( qw/not TOPICINFO TOPICPARENT FORM FIELD FILEATTACHMENT TOPICMOVED/ );
   1.678 +    my $text = $start . $this->{_text};
   1.679 +    $end = "\n".$end if $end;
   1.680 +    $text .= $end;
   1.681 +    return $text;
   1.682 +}
   1.683 +
   1.684 +# STATIC Write a meta-data key=value pair
   1.685 +# The encoding is reversed in _readKeyValues
   1.686 +sub _writeKeyValue {
   1.687 +    my( $key, $value ) = @_;
   1.688 +
   1.689 +    if( defined( $value )) {
   1.690 +        $value = TWiki::Store::dataEncode( $value );
   1.691 +    } else {
   1.692 +        $value = '';
   1.693 +    }
   1.694 +
   1.695 +    return $key.'="'.$value.'"';
   1.696 +}
   1.697 +
   1.698 +# STATIC: Write all the key=value pairs for the types listed
   1.699 +sub _writeTypes {
   1.700 +    my( $this, @types ) = @_;
   1.701 +
   1.702 +    my $text = '';
   1.703 +
   1.704 +    if( $types[0] eq 'not' ) {
   1.705 +        # write all types that are not in the list
   1.706 +        my %seen;
   1.707 +        @seen{ @types } = ();
   1.708 +        @types = ();  # empty "not in list"
   1.709 +        foreach my $key ( keys %$this ) {
   1.710 +            push( @types, $key ) unless
   1.711 +              (exists $seen{ $key } || $key =~ /^_/);
   1.712 +        }
   1.713 +    }
   1.714 +
   1.715 +    foreach my $type ( @types ) {
   1.716 +        my $data = $this->{$type};
   1.717 +        foreach my $item ( @$data ) {
   1.718 +            my $sep = '';
   1.719 +            $text .= '%META:'.$type.'{';
   1.720 +            my $name = $item->{name};
   1.721 +            if( $name ) {
   1.722 +                # If there's a name field, put first to make regexp based searching easier
   1.723 +                $text .= _writeKeyValue( 'name', $item->{name} );
   1.724 +                $sep = ' ';
   1.725 +            }
   1.726 +            foreach my $key ( sort keys %$item ) {
   1.727 +                if( $key ne 'name' ) {
   1.728 +                    $text .= $sep;
   1.729 +                    $text .= _writeKeyValue( $key, $item->{$key} );
   1.730 +                    $sep = ' ';
   1.731 +                }
   1.732 +            }
   1.733 +            $text .= '}%'."\n";
   1.734 +        }
   1.735 +    }
   1.736 +
   1.737 +    return $text;
   1.738 +}
   1.739 +
   1.740 +# Note: not published as part of the interface; private to TWiki
   1.741 +# Add TOPICINFO type data to the object, as specified by the parameters.
   1.742 +#    * =$rev= - the revision number
   1.743 +#    * =$time= - the time stamp
   1.744 +#    * =$user= - the user id
   1.745 +#    * =$repRev= - is the save in progress a repRev
   1.746 +# SMELL: Duplicate rev control info in the topic
   1.747 +sub addTOPICINFO {
   1.748 +    my( $this, $rev, $time, $user, $repRev, $format ) = @_;
   1.749 +    $rev = 1 if $rev < 1;
   1.750 +    my $users = $this->{_session}->{users};
   1.751 +
   1.752 +    my %options =
   1.753 +      (
   1.754 +          # compatibility; older versions of the code use
   1.755 +          # RCS rev numbers save with them so old code can
   1.756 +          # read these topics
   1.757 +          version   => '1.'.$rev,
   1.758 +          date      => $time,
   1.759 +          author    => $user,
   1.760 +          format    => $format,
   1.761 +         );
   1.762 +    # if this is a reprev, then store the revision that was affected.
   1.763 +    # Required so we can tell when a merge is based on something that
   1.764 +    # is *not* the original rev where another users' edit started.
   1.765 +    # See Bugs:Item1897.
   1.766 +    $options{reprev} = '1.'.$rev if $repRev;
   1.767 +
   1.768 +    $this->put( 'TOPICINFO', \%options );
   1.769 +}
   1.770 +
   1.771 +=begin twiki
   1.772 +
   1.773 +---++ ObjectMethod getMetaFor() -> $meta
   1.774 +
   1.775 +This method will load (or otherwise fetch) the meta-data for a named web/topic.
   1.776 +The request might be satisfied by a read from the store, or it might be
   1.777 +satisfied from a cache. The caller doesn't care.
   1.778 +
   1.779 +This is an object method rather than a static method because it depends on
   1.780 +the implementation of Meta - it might be this base class, or it might be a
   1.781 +caching subclass, for example.
   1.782 +
   1.783 +=cut
   1.784 +
   1.785 +sub getMetaFor {
   1.786 +    my ($this, $web, $topic) = @_;
   1.787 +
   1.788 +    my ($m, $t) =  $this->session->{store}->readTopic(undef, $web, $topic);
   1.789 +    return $m; # $t is already in $m->text()
   1.790 +}
   1.791 +
   1.792 +1;
   1.793 +
   1.794 +__DATA__
   1.795 +
   1.796 +Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/
   1.797 +
   1.798 +Copyright (C) 2001-2007 Peter Thoeny, peter@thoeny.org
   1.799 +and TWiki Contributors. All Rights Reserved. TWiki Contributors
   1.800 +are listed in the AUTHORS file in the root of this distribution.
   1.801 +NOTE: Please extend that file, not this notice.
   1.802 +
   1.803 +This program is free software; you can redistribute it and/or
   1.804 +modify it under the terms of the GNU General Public License
   1.805 +as published by the Free Software Foundation; either version 2
   1.806 +of the License, or (at your option) any later version. For
   1.807 +more details read LICENSE in the root of this distribution.
   1.808 +
   1.809 +This program is distributed in the hope that it will be useful,
   1.810 +but WITHOUT ANY WARRANTY; without even the implied warranty of
   1.811 +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
   1.812 +
   1.813 +As per the GPL, removal of this notice is prohibited.