lib/TWiki/Meta.pm
author Colas Nahaboo <colas@nahaboo.net>
Mon, 11 Aug 2008 20:33:37 +0200
changeset 2 7bc60a767fa4
parent 1 e2915a7cbdfa
permissions -rw-r--r--
TWiki-4.2.2 Release
     1 # See bottom of file for license and copyright information
     2 
     3 =pod
     4 
     5 ---+ package TWiki::Meta
     6 
     7 All TWiki topics have *data* (text) and *meta-data* (information about the
     8 topic). Meta-data includes information such as file attachments, form fields,
     9 topic parentage etc. When TWiki loads a topic from the store, it represents
    10 the meta-data in the topic using an object of this class.
    11 
    12 A meta-data object is a hash of different types of meta-data (keyed on
    13 the type, such as 'FIELD' and 'TOPICINFO').
    14 
    15 Each entry in the hash is an array, where each entry in the array
    16 contains another hash of the key=value pairs, corresponding to a
    17 single meta-datum.
    18 
    19 If there may be multiple entries of the same top-level type (i.e. for FIELD
    20 and FILEATTACHMENT) then the array has multiple entries. These types
    21 are referred to as "keyed" types. The array entries are keyed with the
    22 attribute 'name' which must be in each entry in the array.
    23 
    24 For unkeyed types, the array has only one entry.
    25 
    26 Pictorially,
    27    * TOPICINFO
    28       * author => '...'
    29       * date => '...'
    30       * ...
    31    * FILEATTACHMENT
    32       * [0] -> { name => '...' ... }
    33       * [1] -> { name => '...' ... }
    34    * FIELD
    35       * [0] -> { name => '...' ... }
    36       * [1] -> { name => '...' ... }
    37 
    38 As well as the meta-data, the object also stores the web name, topic
    39 name and remaining text after meta-data extraction.
    40 
    41 =cut
    42 
    43 package TWiki::Meta;
    44 
    45 use strict;
    46 use Error qw(:try);
    47 use Assert;
    48 
    49 =pod
    50 
    51 ---++ ClassMethod new($session, $web, $topic, $text)
    52    * =$session= - a TWiki object (e.g. =$TWiki::Plugins::SESSION)
    53    * =$web=, =$topic= - the topic that the metadata relates to
    54 Construct a new, empty object to contain meta-data for the given topic.
    55    * $text - optional raw text to convert to meta-data form
    56 =cut
    57 
    58 sub new {
    59     my ( $class, $session, $web, $topic, $text ) = @_;
    60     my $this = bless( { _session => $session }, $class );
    61 
    62     # Note: internal fields are prepended with _. All uppercase
    63     # fields will be assumed to be meta-data.
    64 
    65     ASSERT($web) if DEBUG;
    66     ASSERT($topic) if DEBUG;
    67 
    68     $this->{_web} = $web;
    69     $this->{_topic} = $topic;
    70     $this->{_text} = '';
    71 
    72     $this->{FILEATTACHMENT} = [];
    73 
    74     if (defined $text) {
    75         $session->{store}->extractMetaData($this, $text);
    76     }
    77 
    78     return $this;
    79 }
    80 
    81 =begin twiki
    82 
    83 ---++ ObjectMethod finish()
    84 Break circular references.
    85 
    86 =cut
    87 
    88 # Note to developers; please undef *all* fields in the object explicitly,
    89 # whether they are references or not. That way this method is "golden
    90 # documentation" of the live fields in the object.
    91 sub finish {
    92     my $this = shift;
    93     undef $this->{_web};
    94     undef $this->{_topic};
    95     undef $this->{_text};
    96     undef $this->{_session};
    97 }
    98 
    99 =pod
   100 
   101 ---++ ObjectMethod session()
   102 
   103 Get the session
   104 
   105 =cut
   106 
   107 sub session {
   108     return $_[0]->{_session};
   109 }
   110 
   111 =pod
   112 
   113 ---++ ObjectMethod web()
   114 
   115 Get the web name
   116 
   117 =cut
   118 
   119 sub web {
   120     return $_[0]->{_web};
   121 }
   122 
   123 =pod
   124 
   125 ---++ ObjectMethod topic()
   126 
   127 Get the topic name
   128 
   129 =cut
   130 
   131 sub topic {
   132     return $_[0]->{_topic};
   133 }
   134 
   135 =pod
   136 
   137 ---++ ObjectMethod text([$text]) -> $text
   138 
   139 Get/set the topic body text. If $text is undef, gets the value, if it is
   140 defined, sets the value to that and returns the new text.
   141 
   142 =cut
   143 
   144 sub text {
   145     my ($this, $val) = @_;
   146     if (defined($val)) {
   147         $this->{_text} = $val;
   148     }
   149     return $this->{_text};
   150 }
   151 
   152 =pod
   153 
   154 ---++ ObjectMethod put($type, \%args)
   155 
   156 Put a hash of key=value pairs into the given type set in this meta. This
   157 will *not* replace another value with the same name (for that see =putKeyed=)
   158 
   159 For example, 
   160 <verbatim>
   161 $meta->put( 'FIELD', { name => 'MaxAge', title => 'Max Age', value =>'103' } );
   162 </verbatim>
   163 
   164 =cut
   165 
   166 sub put {
   167     my( $this, $type, $args ) = @_;
   168 
   169     my $data = $this->{$type};
   170     if( $data ) {
   171         # overwrite old single value
   172         $data->[0] = $args;
   173     } else {
   174         push( @{$this->{$type}}, $args );
   175     }
   176 }
   177 
   178 =pod
   179 
   180 ---++ ObjectMethod putKeyed($type, \%args)
   181 
   182 Put a hash of key=value pairs into the given type set in this meta, replacing
   183 any existing value with the same key.
   184 
   185 For example,
   186 <verbatim>
   187 $meta->putKeyed( 'FIELD', { name => 'MaxAge', title => 'Max Age', value =>'103' } );
   188 </verbatim>
   189 
   190 =cut
   191 
   192 # Note: Array is used instead of a hash to preserve sequence
   193 
   194 sub putKeyed {
   195     my( $this, $type, $args ) = @_;
   196 
   197     my $data = $this->{$type};
   198     if( $data ) {
   199         my $keyName = $args->{name};
   200         ASSERT( $keyName ) if DEBUG;
   201         my $i = scalar( @$data );
   202         while( $keyName && $i-- ) {
   203             if( $data->[$i]->{name} eq $keyName ) {
   204                 $data->[$i] = $args;
   205                 return;
   206             }
   207         }
   208         push @$data, $args;
   209     } else {
   210       push( @{$this->{$type}}, $args );
   211     }
   212 }
   213 
   214 =pod
   215 
   216 ---++ ObjectMethod putAll
   217 
   218 Replaces all the items of a given key with a new array.
   219 
   220 For example,
   221 <verbatim>
   222 $meta->putAll( 'FIELD',
   223      { name => 'MinAge', title => 'Min Age', value =>'50' },
   224      { name => 'MaxAge', title => 'Max Age', value =>'103' },
   225      { name => 'HairColour', title => 'Hair Colour', value =>'white' }
   226  );
   227 </verbatim>
   228 
   229 =cut
   230 
   231 sub putAll {
   232     my( $this, $type, @array ) = @_;
   233 
   234     $this->{$type} = \@array;
   235 }
   236 
   237 =pod
   238 
   239 ---++ ObjectMethod get( $type, $key ) -> \%hash
   240 
   241 Find the value of a meta-datum in the map. If the type is
   242 keyed (idenitifed by a =name=), the =$key= parameter is required
   243 to say _which_ entry you want. Otherwise you will just get the first value.
   244 
   245 If you want all the keys of a given type use the 'find' method.
   246 
   247 The result is a reference to the hash for the item.
   248 
   249 For example,
   250 <verbatim>
   251 my $ma = $meta->get( 'FIELD', 'MinAge' );
   252 my $topicinfo = $meta->get( 'TOPICINFO' ); # get the TOPICINFO hash
   253 </verbatim>
   254 
   255 =cut
   256 
   257 sub get {
   258     my( $this, $type, $keyValue ) = @_;
   259 
   260     my $data = $this->{$type};
   261     if( $data ) {
   262         if( defined $keyValue ) {
   263             foreach my $item ( @$data ) {
   264                 return $item if( $item->{name} eq $keyValue );
   265             }
   266         } else {
   267             return $data->[0];
   268         }
   269     }
   270 
   271     return undef;
   272 }
   273 
   274 =pod
   275 
   276 ---++ ObjectMethod find (  $type  ) -> @values
   277 
   278 Get all meta data for a specific type.
   279 Returns the array stored for the type. This will be zero length
   280 if there are no entries.
   281 
   282 For example,
   283 <verbatim>
   284 my $attachments = $meta->find( 'FILEATTACHMENT' );
   285 </verbatim>
   286 
   287 =cut
   288 
   289 sub find {
   290     my( $this, $type ) = @_;
   291 
   292     my $itemsr = $this->{$type};
   293     my @items = ();
   294 
   295     if( $itemsr ) {
   296         @items = @$itemsr;
   297     }
   298 
   299     return @items;
   300 }
   301 
   302 =pod
   303 
   304 ---++ ObjectMethod remove($type, $key)
   305 
   306 With no type, will remove all the contents of the object.
   307 
   308 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)
   309 
   310 With a $type and a $key it will remove only the specific item.
   311 
   312 =cut
   313 
   314 sub remove {
   315     my( $this, $type, $keyValue ) = @_;
   316 
   317     if( $keyValue ) {
   318        my $data = $this->{$type};
   319        my @newData = ();
   320        foreach my $item ( @$data ) {
   321            if( $item->{name} ne $keyValue ) {
   322                push @newData, $item;
   323            }
   324        }
   325        $this->{$type} = \@newData;
   326     } elsif( $type ) {
   327        delete $this->{$type};
   328     } else {
   329         foreach my $entry ( keys %$this ) {
   330             unless( $entry =~ /^_/ ) {
   331                 $this->remove( $entry );
   332             }
   333         }
   334     }
   335 }
   336 
   337 =pod
   338 
   339 ---++ ObjectMethod copyFrom( $otherMeta, $type, $nameFilter )
   340 
   341 Copy all entries of a type from another meta data set. This
   342 will destroy the old values for that type, unless the
   343 copied object doesn't contain entries for that type, in which
   344 case it will retain the old values.
   345 
   346 If $type is undef, will copy ALL TYPES.
   347 
   348 If $nameFilter is defined (a perl refular expression), it will copy
   349 only data where ={name}= matches $nameFilter.
   350 
   351 Does *not* copy web, topic or text.
   352 
   353 =cut
   354 
   355 sub copyFrom {
   356     my( $this, $otherMeta, $type, $filter ) = @_;
   357     ASSERT($otherMeta->isa( 'TWiki::Meta')) if DEBUG;
   358 
   359     if( $type ) {
   360         foreach my $item ( @{$otherMeta->{$type}} ) {
   361             if( !$filter || ( $item->{name} && $item->{name} =~ /$filter/ )) {
   362                 my %data = map { $_ => $item->{$_} } keys %$item;
   363                 push( @{$this->{$type}}, \%data );
   364             }
   365         }
   366     } else {
   367         foreach my $k ( keys %$otherMeta ) {
   368             # Don't copy the web and topic fields, this may be a new topic
   369             unless( $k =~ /^_/ ) {
   370                 $this->copyFrom( $otherMeta, $k );
   371             }
   372         }
   373     }
   374 }
   375 
   376 =pod
   377 
   378 ---++ ObjectMethod count($type) -> $integer
   379 
   380 Return the number of entries of the given type
   381 
   382 =cut
   383 
   384 sub count {
   385     my( $this, $type ) = @_;
   386     my $data = $this->{$type};
   387 
   388     return scalar @$data if( defined( $data ));
   389 
   390     return 0;
   391 }
   392 
   393 =pod
   394 
   395 ---++ ObjectMethod getRevisionInfo($fromrev) -> ( $date, $author, $rev, $comment )
   396 
   397 Try and get revision info from the meta information, or, if it is not
   398 present, kick down to the Store module for the same information.
   399 
   400 Returns ( $revDate, $author, $rev, $comment )
   401 
   402 $rev is an integer revision number.
   403 
   404 =cut
   405 
   406 sub getRevisionInfo {
   407     my( $this, $fromrev ) = @_;
   408     my $store = $this->{_session}->{store};
   409 
   410     my $topicinfo = $this->get( 'TOPICINFO' );
   411 
   412     my( $date, $author, $rev, $comment );
   413     if( $topicinfo ) {
   414         $date = $topicinfo->{date} ;
   415         $author = $topicinfo->{author};
   416         $rev = $topicinfo->{version};
   417         $rev =~ s/^\$Rev(:\s*\d+)?\s*\$$/0/; # parse out SVN keywords in doc
   418         $rev =~ s/^\d+\.//;
   419         $comment = '';
   420         if ( !$fromrev || $rev eq $fromrev ) {
   421             return( $date, $author, $rev, $comment );
   422         }
   423     }
   424     # Different rev, or no topic info, delegate to Store
   425     ( $date, $author, $rev, $comment ) =
   426       $store->getRevisionInfo( $this->{_web}, $this->{_topic}, $fromrev );
   427     return( $date, $author, $rev, $comment );
   428 }
   429 
   430 =pod
   431 
   432 ---++ ObjectMethod merge( $otherMeta, $formDef )
   433 
   434    * =$otherMeta= - a block of meta-data to merge with $this
   435    * =$formDef= reference to a TWiki::Form that gives the types of the fields in $this
   436 
   437 Merge the data in the other meta block.
   438    * File attachments that only appear in one set are preserved.
   439    * Form fields that only appear in one set are preserved.
   440    * Form field values that are different in each set are text-merged
   441    * We don't merge for field attributes or title
   442    * Topic info is not touched
   443    * 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.
   444 
   445 =cut
   446 
   447 sub merge {
   448     my ( $this, $other, $formDef ) = @_;
   449 
   450     my $data = $other->{FIELD};
   451     if( $data ) {
   452         foreach my $otherD ( @$data ) {
   453             my $thisD = $this->get( 'FIELD', $otherD->{name} );
   454             if ( $thisD && $thisD->{value} ne $otherD->{value} ) {
   455                 if( $formDef->isTextMergeable( $thisD->{name} )) {
   456                     require TWiki::Merge;
   457                     my $merged = TWiki::Merge::merge2(
   458                         'A', $otherD->{value}, 'B', $thisD->{value},
   459                         '.*?\s+',
   460                         $this->{_session},
   461                         $formDef->getField( $thisD->{name} ) );
   462                     # SMELL: we don't merge attributes or title
   463                     $thisD->{value} = $merged;
   464                 }
   465             } elsif ( !$thisD ) {
   466                 $this->putKeyed('FIELD', $otherD );
   467             }
   468         }
   469     }
   470 
   471     $data = $other->{FILEATTACHMENT};
   472     if( $data ) {
   473         foreach my $otherD ( @$data ) {
   474             my $thisD = $this->get( 'FILEATTACHMENT', $otherD->{name} );
   475             if ( !$thisD ) {
   476                 $this->putKeyed('FILEATTACHMENT', $otherD );
   477             }
   478         }
   479     }
   480 }
   481 
   482 =pod
   483 
   484 ---++ ObjectMethod stringify( $types ) -> $string
   485 
   486 Return a string version of the meta object. Uses \n to separate lines.
   487 If =$types= is specified, return only types
   488 that match it. Types should be a perl regular expression.
   489 
   490 =cut
   491 
   492 sub stringify {
   493     my( $this, $types ) = @_;
   494     my $s = '';
   495     $types ||= qr/^[A-Z]+$/;
   496 
   497     foreach my $type ( grep { /$types/ } keys %$this ) {
   498         foreach my $item ( @{$this->{$type}} ) {
   499             #remove the internal 'info.rev'
   500             my $topicRev = $item->{'rev'};
   501             if ($type eq 'TOPICINFO') {
   502                 undef $item->{'rev'};
   503             }
   504             my @itemKeys = sort keys %$item;
   505             $s .= "$type: " .
   506               join(' ', map{ "$_='".($item->{$_}||'')."'" }
   507                       @itemKeys ) .
   508                        "\n";
   509             if ($type eq 'TOPICINFO' && defined($topicRev)) {
   510                 $item->{'rev'} = $topicRev;
   511             }
   512         }
   513     }
   514     return $s;
   515 }
   516 
   517 =pod
   518 
   519 ---++ ObjectMethod forEachSelectedValue( $types, $keys, \&fn, \%options )
   520 
   521 Iterate over the values selected by the regular expressions in $types and
   522 $keys.
   523    * =$types= - regular expression matching the names of fields to be processed. Will default to qr/^[A-Z]+$/ if undef.
   524    * =$keys= - regular expression matching the names of keys to be processed.  Will default to qr/^[a-z]+$/ if undef.
   525 
   526 Iterates over each value, calling =\&fn= on each, and replacing the value
   527 with the result of \&fn.
   528 
   529 \%options will be passed on to $fn, with the following additions:
   530    * =_type= => the type name (e.g. "FILEATTACHMENT")
   531    * =_key= => the key name (e.g. "user")
   532 
   533 =cut
   534 
   535 sub forEachSelectedValue {
   536     my( $this, $types, $keys, $fn, $options ) = @_;
   537 
   538     $types ||= qr/^[A-Z]+$/;
   539     $keys ||= qr/^[a-z]+$/;
   540 
   541     foreach my $type ( grep { /$types/ } keys %$this ) {
   542         $options->{_type} = $type;
   543         my $data = $this->{$type};
   544         next unless $data;
   545         foreach my $datum ( @$data ) {
   546             foreach my $key ( grep { /$keys/ } keys %$datum ) {
   547                 $options->{_key} = $key;
   548                 $datum->{$key} = &$fn( $datum->{$key}, $options );
   549             }
   550         }
   551     }
   552 }
   553 
   554 =pod
   555 
   556 ---++ ObjectMethod getParent() -> $parent
   557 
   558 Gets the TOPICPARENT name.
   559 
   560 =cut
   561 
   562 sub getParent {
   563     my( $this ) = @_;
   564 
   565     my $value = '';
   566     my $parent = $this->get( 'TOPICPARENT' );
   567     $value = $parent->{name} if( $parent );
   568     # Return empty string (not undef), if TOPICPARENT meta is broken
   569     $value = '' if (!defined $value);
   570     return $value;
   571 }
   572 
   573 =pod
   574 
   575 ---++ ObjectMethod getFormName() -> $formname
   576 
   577 Returns the name of the FORM, or '' if none.
   578 
   579 =cut
   580 
   581 sub getFormName {
   582     my( $this ) = @_;
   583 
   584     my $aForm = $this->get( 'FORM' );
   585     if( $aForm ) {
   586         return $aForm->{name};
   587     }
   588     return '';
   589 }
   590 
   591 =pod
   592 
   593 ---++ ObjectMethod renderFormForDisplay() -> $html
   594 
   595 Render the form contained in the meta for display.
   596 
   597 =cut
   598 
   599 sub renderFormForDisplay {
   600     my $this = shift;
   601 
   602     my $fname = $this->getFormName();
   603 
   604     require TWiki::Form;
   605     return '' unless $fname;
   606 
   607     my $form = new TWiki::Form( $this->{_session}, $this->{_web}, $fname );
   608 
   609     if( $form ) {
   610         return $form->renderForDisplay( $this );
   611     } else {
   612         return CGI::span({class => 'twikiAlert'},
   613                          "Form definition '$fname' not found");
   614     }
   615 }
   616 
   617 =pod
   618 
   619 ---++ ObjectMethod renderFormFieldForDisplay($name, $format, $attrs) -> $text
   620 
   621 Render a single formfield, using the $format. See
   622 TWiki::Form::FormField::renderForDisplay for a description of how the value
   623 is rendered.
   624 
   625 =cut
   626 
   627 sub renderFormFieldForDisplay {
   628     my( $this, $name, $format, $attrs ) = @_;
   629 
   630     my $value;
   631     my $mf = $this->get( 'FIELD', $name );
   632     unless( $mf ) {
   633         # Not a valid field name, maybe it's a title.
   634         require TWiki::Form;
   635         $name = TWiki::Form::fieldTitle2FieldName( $name );
   636         $mf = $this->get( 'FIELD', $name);
   637     }
   638     return '' unless $mf; # field not found
   639 
   640     $value = $mf->{value};
   641 
   642     my $fname = $this->getFormName();
   643     if( $fname ) {
   644         require TWiki::Form;
   645         my $form = new TWiki::Form( $this->{_session}, $this->{_web}, $fname );
   646         if( $form ) {
   647             my $field = $form->getField( $name );
   648             if( $field ) {
   649                 return $field->renderForDisplay( $format, $value, $attrs );
   650             }
   651         }
   652     }
   653     # Form or field wasn't found, do your best!
   654     my $f = $this->get( 'FIELD', $name );
   655     if( $f ) {
   656         $format =~ s/\$title/$f->{title}/;
   657         require TWiki::Render;
   658         $value = TWiki::Render::protectFormFieldValue( $value, $attrs );
   659         $format =~ s/\$value/$value/;
   660     }
   661     return $format;
   662 }
   663 
   664 =pod
   665 
   666 ---++ ObjectMethod getEmbeddedStoreForm() -> $text
   667 
   668 Generate the embedded store form of the topic. The embedded store
   669 form has meta-data values embedded using %META: lines. The text
   670 stored in the meta is taken as the topic text.
   671 
   672 =cut
   673 
   674 sub getEmbeddedStoreForm {
   675     my $this = shift;
   676     $this->{_text} ||= '';
   677 
   678     require TWiki::Store;
   679 
   680     my $start = $this->_writeTypes( qw/TOPICINFO TOPICPARENT/ );
   681     my $end = $this->_writeTypes( qw/FORM FIELD FILEATTACHMENT TOPICMOVED/ );
   682     # append remaining meta data
   683     $end .= $this->_writeTypes( qw/not TOPICINFO TOPICPARENT FORM FIELD FILEATTACHMENT TOPICMOVED/ );
   684     my $text = $start . $this->{_text};
   685     $end = "\n".$end if $end;
   686     $text .= $end;
   687     return $text;
   688 }
   689 
   690 # STATIC Write a meta-data key=value pair
   691 # The encoding is reversed in _readKeyValues
   692 sub _writeKeyValue {
   693     my( $key, $value ) = @_;
   694 
   695     if( defined( $value )) {
   696         $value = TWiki::Store::dataEncode( $value );
   697     } else {
   698         $value = '';
   699     }
   700 
   701     return $key.'="'.$value.'"';
   702 }
   703 
   704 # STATIC: Write all the key=value pairs for the types listed
   705 sub _writeTypes {
   706     my( $this, @types ) = @_;
   707 
   708     my $text = '';
   709 
   710     if( $types[0] eq 'not' ) {
   711         # write all types that are not in the list
   712         my %seen;
   713         @seen{ @types } = ();
   714         @types = ();  # empty "not in list"
   715         foreach my $key ( keys %$this ) {
   716             push( @types, $key ) unless
   717               (exists $seen{ $key } || $key =~ /^_/);
   718         }
   719     }
   720 
   721     foreach my $type ( @types ) {
   722         my $data = $this->{$type};
   723         foreach my $item ( @$data ) {
   724             my $sep = '';
   725             $text .= '%META:'.$type.'{';
   726             my $name = $item->{name};
   727             if( $name ) {
   728                 # If there's a name field, put first to make regexp based searching easier
   729                 $text .= _writeKeyValue( 'name', $item->{name} );
   730                 $sep = ' ';
   731             }
   732             foreach my $key ( sort keys %$item ) {
   733                 #don't store the rev created in addTOPICINFO
   734                 next if ($type eq 'TOPICINFO' && $key eq 'rev');
   735                 if( $key ne 'name' ) {
   736                     $text .= $sep;
   737                     $text .= _writeKeyValue( $key, $item->{$key} );
   738                     $sep = ' ';
   739                 }
   740             }
   741             $text .= '}%'."\n";
   742         }
   743     }
   744 
   745     return $text;
   746 }
   747 
   748 # Note: not published as part of the interface; private to TWiki
   749 # Add TOPICINFO type data to the object, as specified by the parameters.
   750 #    * =$rev= - the revision number
   751 #    * =$time= - the time stamp
   752 #    * =$user= - the user id
   753 #    * =$repRev= - is the save in progress a repRev
   754 # SMELL: Duplicate rev control info in the topic
   755 sub addTOPICINFO {
   756     my( $this, $rev, $time, $user, $repRev, $format ) = @_;
   757     $rev = 1 if $rev < 1;
   758     my $users = $this->{_session}->{users};
   759 
   760     my %options =
   761       (
   762           # compatibility; older versions of the code use
   763           # RCS rev numbers save with them so old code can
   764           # read these topics
   765           version   => '1.'.$rev,
   766           rev       => $rev,
   767           date      => $time,
   768           author    => $user,
   769           format    => $format,
   770          );
   771     # if this is a reprev, then store the revision that was affected.
   772     # Required so we can tell when a merge is based on something that
   773     # is *not* the original rev where another users' edit started.
   774     # See Bugs:Item1897.
   775     $options{reprev} = '1.'.$rev if $repRev;
   776 
   777     $this->put( 'TOPICINFO', \%options );
   778 }
   779 
   780 =begin twiki
   781 
   782 ---++ ObjectMethod getMetaFor() -> $meta
   783 
   784 This method will load (or otherwise fetch) the meta-data for a named web/topic.
   785 The request might be satisfied by a read from the store, or it might be
   786 satisfied from a cache. The caller doesn't care.
   787 
   788 This is an object method rather than a static method because it depends on
   789 the implementation of Meta - it might be this base class, or it might be a
   790 caching subclass, for example.
   791 
   792 =cut
   793 
   794 sub getMetaFor {
   795     my ($this, $web, $topic) = @_;
   796 
   797     my ($m, $t) =  $this->session->{store}->readTopic(undef, $web, $topic);
   798     return $m; # $t is already in $m->text()
   799 }
   800 
   801 1;
   802 
   803 __DATA__
   804 
   805 Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/
   806 
   807 Copyright (C) 2001-2007 Peter Thoeny, peter@thoeny.org
   808 and TWiki Contributors. All Rights Reserved. TWiki Contributors
   809 are listed in the AUTHORS file in the root of this distribution.
   810 NOTE: Please extend that file, not this notice.
   811 
   812 This program is free software; you can redistribute it and/or
   813 modify it under the terms of the GNU General Public License
   814 as published by the Free Software Foundation; either version 2
   815 of the License, or (at your option) any later version. For
   816 more details read LICENSE in the root of this distribution.
   817 
   818 This program is distributed in the hope that it will be useful,
   819 but WITHOUT ANY WARRANTY; without even the implied warranty of
   820 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
   821 
   822 As per the GPL, removal of this notice is prohibited.