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.