lib/TWiki/Meta.pm
changeset 0 414e01d06fd5
child 1 e2915a7cbdfa
equal deleted inserted replaced
-1:000000000000 0:414e01d06fd5
       
     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             $s .= "$type: " .
       
   500               join(' ', map{ "$_='".($item->{$_}||'')."'" }
       
   501                      sort keys %$item ) .
       
   502                        "\n";
       
   503         }
       
   504     }
       
   505     return $s;
       
   506 }
       
   507 
       
   508 =pod
       
   509 
       
   510 ---++ ObjectMethod forEachSelectedValue( $types, $keys, \&fn, \%options )
       
   511 
       
   512 Iterate over the values selected by the regular expressions in $types and
       
   513 $keys.
       
   514    * =$types= - regular expression matching the names of fields to be processed. Will default to qr/^[A-Z]+$/ if undef.
       
   515    * =$keys= - regular expression matching the names of keys to be processed.  Will default to qr/^[a-z]+$/ if undef.
       
   516 
       
   517 Iterates over each value, calling =\&fn= on each, and replacing the value
       
   518 with the result of \&fn.
       
   519 
       
   520 \%options will be passed on to $fn, with the following additions:
       
   521    * =_type= => the type name (e.g. "FILEATTACHMENT")
       
   522    * =_key= => the key name (e.g. "user")
       
   523 
       
   524 =cut
       
   525 
       
   526 sub forEachSelectedValue {
       
   527     my( $this, $types, $keys, $fn, $options ) = @_;
       
   528 
       
   529     $types ||= qr/^[A-Z]+$/;
       
   530     $keys ||= qr/^[a-z]+$/;
       
   531 
       
   532     foreach my $type ( grep { /$types/ } keys %$this ) {
       
   533         $options->{_type} = $type;
       
   534         my $data = $this->{$type};
       
   535         next unless $data;
       
   536         foreach my $datum ( @$data ) {
       
   537             foreach my $key ( grep { /$keys/ } keys %$datum ) {
       
   538                 $options->{_key} = $key;
       
   539                 $datum->{$key} = &$fn( $datum->{$key}, $options );
       
   540             }
       
   541         }
       
   542     }
       
   543 }
       
   544 
       
   545 =pod
       
   546 
       
   547 ---++ ObjectMethod getParent() -> $parent
       
   548 
       
   549 Gets the TOPICPARENT name.
       
   550 
       
   551 =cut
       
   552 
       
   553 sub getParent {
       
   554     my( $this ) = @_;
       
   555 
       
   556     my $value = '';
       
   557     my $parent = $this->get( 'TOPICPARENT' );
       
   558     $value = $parent->{name} if( $parent );
       
   559     # Return empty string (not undef), if TOPICPARENT meta is broken
       
   560     $value = '' if (!defined $value);
       
   561     return $value;
       
   562 }
       
   563 
       
   564 =pod
       
   565 
       
   566 ---++ ObjectMethod getFormName() -> $formname
       
   567 
       
   568 Returns the name of the FORM, or '' if none.
       
   569 
       
   570 =cut
       
   571 
       
   572 sub getFormName {
       
   573     my( $this ) = @_;
       
   574 
       
   575     my $aForm = $this->get( 'FORM' );
       
   576     if( $aForm ) {
       
   577         return $aForm->{name};
       
   578     }
       
   579     return '';
       
   580 }
       
   581 
       
   582 =pod
       
   583 
       
   584 ---++ ObjectMethod renderFormForDisplay() -> $html
       
   585 
       
   586 Render the form contained in the meta for display.
       
   587 
       
   588 =cut
       
   589 
       
   590 sub renderFormForDisplay {
       
   591     my $this = shift;
       
   592 
       
   593     my $fname = $this->getFormName();
       
   594 
       
   595     require TWiki::Form;
       
   596     return '' unless $fname;
       
   597 
       
   598     my $form = new TWiki::Form( $this->{_session}, $this->{_web}, $fname );
       
   599 
       
   600     if( $form ) {
       
   601         return $form->renderForDisplay( $this );
       
   602     } else {
       
   603         return CGI::span({class => 'twikiAlert'},
       
   604                          "Form definition '$fname' not found");
       
   605     }
       
   606 }
       
   607 
       
   608 =pod
       
   609 
       
   610 ---++ ObjectMethod renderFormFieldForDisplay($name, $format, $attrs) -> $text
       
   611 
       
   612 Render a single formfield, using the $format. See
       
   613 TWiki::Form::FormField::renderForDisplay for a description of how the value
       
   614 is rendered.
       
   615 
       
   616 =cut
       
   617 
       
   618 sub renderFormFieldForDisplay {
       
   619     my( $this, $name, $format, $attrs ) = @_;
       
   620 
       
   621     my $value;
       
   622     my $mf = $this->get( 'FIELD', $name );
       
   623     unless( $mf ) {
       
   624         # Not a valid field name, maybe it's a title.
       
   625         require TWiki::Form;
       
   626         $name = TWiki::Form::fieldTitle2FieldName( $name );
       
   627         $mf = $this->get( 'FIELD', $name);
       
   628     }
       
   629     return '' unless $mf; # field not found
       
   630 
       
   631     $value = $mf->{value};
       
   632 
       
   633     my $fname = $this->getFormName();
       
   634     if( $fname ) {
       
   635         require TWiki::Form;
       
   636         my $form = new TWiki::Form( $this->{_session}, $this->{_web}, $fname );
       
   637         if( $form ) {
       
   638             my $field = $form->getField( $name );
       
   639             if( $field ) {
       
   640                 return $field->renderForDisplay( $format, $value, $attrs );
       
   641             }
       
   642         }
       
   643     }
       
   644     # Form or field wasn't found, do your best!
       
   645     my $f = $this->get( 'FIELD', $name );
       
   646     if( $f ) {
       
   647         $format =~ s/\$title/$f->{title}/;
       
   648         require TWiki::Render;
       
   649         $value = TWiki::Render::protectFormFieldValue( $value, $attrs );
       
   650         $format =~ s/\$value/$value/;
       
   651     }
       
   652     return $format;
       
   653 }
       
   654 
       
   655 =pod
       
   656 
       
   657 ---++ ObjectMethod getEmbeddedStoreForm() -> $text
       
   658 
       
   659 Generate the embedded store form of the topic. The embedded store
       
   660 form has meta-data values embedded using %META: lines. The text
       
   661 stored in the meta is taken as the topic text.
       
   662 
       
   663 =cut
       
   664 
       
   665 sub getEmbeddedStoreForm {
       
   666     my $this = shift;
       
   667     $this->{_text} ||= '';
       
   668 
       
   669     require TWiki::Store;
       
   670 
       
   671     my $start = $this->_writeTypes( qw/TOPICINFO TOPICPARENT/ );
       
   672     my $end = $this->_writeTypes( qw/FORM FIELD FILEATTACHMENT TOPICMOVED/ );
       
   673     # append remaining meta data
       
   674     $end .= $this->_writeTypes( qw/not TOPICINFO TOPICPARENT FORM FIELD FILEATTACHMENT TOPICMOVED/ );
       
   675     my $text = $start . $this->{_text};
       
   676     $end = "\n".$end if $end;
       
   677     $text .= $end;
       
   678     return $text;
       
   679 }
       
   680 
       
   681 # STATIC Write a meta-data key=value pair
       
   682 # The encoding is reversed in _readKeyValues
       
   683 sub _writeKeyValue {
       
   684     my( $key, $value ) = @_;
       
   685 
       
   686     if( defined( $value )) {
       
   687         $value = TWiki::Store::dataEncode( $value );
       
   688     } else {
       
   689         $value = '';
       
   690     }
       
   691 
       
   692     return $key.'="'.$value.'"';
       
   693 }
       
   694 
       
   695 # STATIC: Write all the key=value pairs for the types listed
       
   696 sub _writeTypes {
       
   697     my( $this, @types ) = @_;
       
   698 
       
   699     my $text = '';
       
   700 
       
   701     if( $types[0] eq 'not' ) {
       
   702         # write all types that are not in the list
       
   703         my %seen;
       
   704         @seen{ @types } = ();
       
   705         @types = ();  # empty "not in list"
       
   706         foreach my $key ( keys %$this ) {
       
   707             push( @types, $key ) unless
       
   708               (exists $seen{ $key } || $key =~ /^_/);
       
   709         }
       
   710     }
       
   711 
       
   712     foreach my $type ( @types ) {
       
   713         my $data = $this->{$type};
       
   714         foreach my $item ( @$data ) {
       
   715             my $sep = '';
       
   716             $text .= '%META:'.$type.'{';
       
   717             my $name = $item->{name};
       
   718             if( $name ) {
       
   719                 # If there's a name field, put first to make regexp based searching easier
       
   720                 $text .= _writeKeyValue( 'name', $item->{name} );
       
   721                 $sep = ' ';
       
   722             }
       
   723             foreach my $key ( sort keys %$item ) {
       
   724                 if( $key ne 'name' ) {
       
   725                     $text .= $sep;
       
   726                     $text .= _writeKeyValue( $key, $item->{$key} );
       
   727                     $sep = ' ';
       
   728                 }
       
   729             }
       
   730             $text .= '}%'."\n";
       
   731         }
       
   732     }
       
   733 
       
   734     return $text;
       
   735 }
       
   736 
       
   737 # Note: not published as part of the interface; private to TWiki
       
   738 # Add TOPICINFO type data to the object, as specified by the parameters.
       
   739 #    * =$rev= - the revision number
       
   740 #    * =$time= - the time stamp
       
   741 #    * =$user= - the user id
       
   742 #    * =$repRev= - is the save in progress a repRev
       
   743 # SMELL: Duplicate rev control info in the topic
       
   744 sub addTOPICINFO {
       
   745     my( $this, $rev, $time, $user, $repRev, $format ) = @_;
       
   746     $rev = 1 if $rev < 1;
       
   747     my $users = $this->{_session}->{users};
       
   748 
       
   749     my %options =
       
   750       (
       
   751           # compatibility; older versions of the code use
       
   752           # RCS rev numbers save with them so old code can
       
   753           # read these topics
       
   754           version   => '1.'.$rev,
       
   755           date      => $time,
       
   756           author    => $user,
       
   757           format    => $format,
       
   758          );
       
   759     # if this is a reprev, then store the revision that was affected.
       
   760     # Required so we can tell when a merge is based on something that
       
   761     # is *not* the original rev where another users' edit started.
       
   762     # See Bugs:Item1897.
       
   763     $options{reprev} = '1.'.$rev if $repRev;
       
   764 
       
   765     $this->put( 'TOPICINFO', \%options );
       
   766 }
       
   767 
       
   768 =begin twiki
       
   769 
       
   770 ---++ ObjectMethod getMetaFor() -> $meta
       
   771 
       
   772 This method will load (or otherwise fetch) the meta-data for a named web/topic.
       
   773 The request might be satisfied by a read from the store, or it might be
       
   774 satisfied from a cache. The caller doesn't care.
       
   775 
       
   776 This is an object method rather than a static method because it depends on
       
   777 the implementation of Meta - it might be this base class, or it might be a
       
   778 caching subclass, for example.
       
   779 
       
   780 =cut
       
   781 
       
   782 sub getMetaFor {
       
   783     my ($this, $web, $topic) = @_;
       
   784 
       
   785     my ($m, $t) =  $this->session->{store}->readTopic(undef, $web, $topic);
       
   786     return $m; # $t is already in $m->text()
       
   787 }
       
   788 
       
   789 1;
       
   790 
       
   791 __DATA__
       
   792 
       
   793 Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/
       
   794 
       
   795 Copyright (C) 2001-2007 Peter Thoeny, peter@thoeny.org
       
   796 and TWiki Contributors. All Rights Reserved. TWiki Contributors
       
   797 are listed in the AUTHORS file in the root of this distribution.
       
   798 NOTE: Please extend that file, not this notice.
       
   799 
       
   800 This program is free software; you can redistribute it and/or
       
   801 modify it under the terms of the GNU General Public License
       
   802 as published by the Free Software Foundation; either version 2
       
   803 of the License, or (at your option) any later version. For
       
   804 more details read LICENSE in the root of this distribution.
       
   805 
       
   806 This program is distributed in the hope that it will be useful,
       
   807 but WITHOUT ANY WARRANTY; without even the implied warranty of
       
   808 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
       
   809 
       
   810 As per the GPL, removal of this notice is prohibited.