2154 lines
66 KiB
Perl
2154 lines
66 KiB
Perl
# Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/
|
|
#
|
|
# Copyright (C) 2002-2007 Peter Thoeny, peter@thoeny.org
|
|
# and TWiki Contributors. All Rights Reserved. TWiki Contributors
|
|
# are listed in the AUTHORS file in the root of this distribution.
|
|
# NOTE: Please extend that file, not this notice.
|
|
#
|
|
# This program is free software; you can redistribute it and/or
|
|
# modify it under the terms of the GNU General Public License
|
|
# as published by the Free Software Foundation; either version 2
|
|
# of the License, or (at your option) any later version. For
|
|
# more details read LICENSE in the root of this distribution.
|
|
#
|
|
# This program is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
#
|
|
# As per the GPL, removal of this notice is prohibited.
|
|
|
|
=begin twiki
|
|
|
|
---+ package TWiki::Store
|
|
|
|
This module hosts the generic storage backend. This module provides
|
|
the interface layer between the "real" store provider - which is hidden
|
|
behind a handler - and the rest of the system. it is responsible for
|
|
checking for topic existance, access permissions, and all the other
|
|
general admin tasks that are common to all store implementations.
|
|
|
|
This module knows nothing about how the data is actually _stored_ -
|
|
that knowledge is entirely encapsulated in the handlers.
|
|
|
|
The general contract for methods in the class requires that errors
|
|
are signalled using exceptions. TWiki::AccessControlException is
|
|
used for access control exceptions, and Error::Simple for all other
|
|
types of error.
|
|
|
|
=cut
|
|
|
|
package TWiki::Store;
|
|
|
|
use strict;
|
|
|
|
use Assert;
|
|
use Error qw( :try );
|
|
|
|
use TWiki::Meta ();
|
|
use TWiki::Time ();
|
|
use TWiki::AccessControlException ();
|
|
|
|
use vars qw( $STORE_FORMAT_VERSION );
|
|
|
|
$STORE_FORMAT_VERSION = '1.1';
|
|
|
|
BEGIN {
|
|
# Do a dynamic 'use locale' for this module
|
|
if( $TWiki::cfg{UseLocale} ) {
|
|
require locale;
|
|
import locale();
|
|
}
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ClassMethod new()
|
|
|
|
Construct a Store module, linking in the chosen sub-implementation.
|
|
|
|
=cut
|
|
|
|
sub new {
|
|
my ( $class, $session ) = @_;
|
|
ASSERT($session->isa('TWiki')) if DEBUG;
|
|
|
|
my $this = bless( {}, $class );
|
|
|
|
$this->{session} = $session;
|
|
|
|
$this->{IMPL} = 'TWiki::Store::'.$TWiki::cfg{StoreImpl};
|
|
eval 'use '.$this->{IMPL};
|
|
if( $@ ) {
|
|
die "$this->{IMPL} compile failed $@";
|
|
}
|
|
|
|
return $this;
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod finish
|
|
|
|
Complete processing after the client's HTTP request has been responded
|
|
to.
|
|
1 breaking circular references to allow garbage collection in persistent
|
|
environments
|
|
|
|
=cut
|
|
|
|
sub finish {
|
|
my $this = shift;
|
|
$this->{IMPL}->finish();
|
|
}
|
|
|
|
# PRIVATE
|
|
# Get the handler for the current store implementation.
|
|
# $web, $topic and $attachment _must_ be untainted.
|
|
sub _getHandler {
|
|
my( $this, $web, $topic, $attachment ) = @_;
|
|
|
|
return $this->{IMPL}->new( $this->{session}, $web, $topic, $attachment );
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod readTopic($user, $web, $topic, $version) -> ($metaObject, $text)
|
|
|
|
Reads the given version of a topic and it's meta-data. If the version
|
|
is undef, then read the most recent version. The version number must be
|
|
an integer, or undef for the latest version.
|
|
|
|
if $user is defined, view permission will be required for the topic
|
|
read to be successful. Access control violations are flagged by a
|
|
TWiki::AccessControlException. Permissions are checked for the user
|
|
name passed in.
|
|
|
|
If the topic contains a web specification (is of the form Web.Topic) the
|
|
web specification will override whatever is passed in $web.
|
|
|
|
The metadata and topic text are returned separately, with the metadata in a
|
|
TWiki::Meta object. (The topic text is, as usual, just a string.)
|
|
|
|
=cut
|
|
|
|
sub readTopic {
|
|
my( $this, $user, $web, $topic, $version ) = @_;
|
|
ASSERT($this->isa('TWiki::Store')) if DEBUG;
|
|
$web =~ s#\.#/#go;
|
|
|
|
if (defined $version) {
|
|
$version = $this->cleanUpRevID( $version );
|
|
}
|
|
|
|
my $text = $this->readTopicRaw( $user, $web, $topic, $version );
|
|
my $meta = new TWiki::Meta( $this->{session}, $web, $topic);
|
|
$this->extractMetaData( $meta, \$text );
|
|
|
|
# Override meta with that blended from pub.
|
|
$meta = $this->_extractMetaDataAutoAttachments($user, $web, $topic, $version, $meta );
|
|
|
|
return( $meta, $text );
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod readTopicRaw( $user, $web, $topic, $version ) -> $topicText
|
|
|
|
Reads the given version of a topic, without separating out any embedded
|
|
meta-data. If the version is undef, then read the most recent version.
|
|
The version number must be an integer or undef.
|
|
|
|
If $user is defined, view permission will be required for the topic
|
|
read to be successful. Access control violations are flagged by a
|
|
TWiki::AccessControlException. Permissions are checked for the user
|
|
name passed in.
|
|
|
|
If the topic contains a web specification (is of the form Web.Topic) the
|
|
web specification will override whatever is passed in $web.
|
|
|
|
SMELL: DO NOT CALL THIS METHOD UNLESS YOU HAVE NO CHOICE. This method breaks
|
|
encapsulation of the store, as it assumes meta is stored embedded in the text.
|
|
Other implementors of store will be forced to insert meta-data to ensure
|
|
correct operation of View raw=debug and the 'repRev' mode of Edit.
|
|
|
|
$web and $topic _must_ be untainted.
|
|
|
|
=cut
|
|
|
|
sub readTopicRaw {
|
|
my( $this, $user, $web, $topic, $version ) = @_;
|
|
ASSERT($this->isa('TWiki::Store')) if DEBUG;
|
|
$web =~ s#\.#/#go;
|
|
|
|
# test if topic contains a webName to override $web
|
|
( $web, $topic ) =
|
|
$this->{session}->normalizeWebTopicName( $web, $topic );
|
|
|
|
my $text;
|
|
|
|
my $handler = $this->_getHandler( $web, $topic );
|
|
unless ( $version ) {
|
|
$text = $handler->getLatestRevision();
|
|
} else {
|
|
$text = $handler->getRevision( $version );
|
|
}
|
|
|
|
# Note: passing undef as meta will cause extraction of the meta
|
|
# from the (raw) text passed
|
|
if( $user &&
|
|
!$this->{session}->{security}->checkAccessPermission
|
|
( 'view', $user, $text, undef, $topic, $web )) {
|
|
throw TWiki::AccessControlException(
|
|
'VIEW', $user, $web, $topic,
|
|
$this->{session}->{security}->getReason());
|
|
}
|
|
|
|
return $text;
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod moveAttachment( $oldWeb, $oldTopic, $oldAttachment, $newWeb, $newTopic, $newAttachment, $user )
|
|
|
|
Move an attachment from one topic to another.
|
|
|
|
The caller to this routine should check that all topics are valid.
|
|
|
|
All parameters must be defined, and must be untainted.
|
|
|
|
=cut
|
|
|
|
sub moveAttachment {
|
|
my( $this, $oldWeb, $oldTopic, $oldAttachment,
|
|
$newWeb, $newTopic, $newAttachment, $user ) = @_;
|
|
ASSERT($this->isa('TWiki::Store')) if DEBUG;
|
|
ASSERT($user->isa('TWiki::User')) if DEBUG;
|
|
|
|
$this->lockTopic( $user, $oldWeb, $oldTopic );
|
|
try {
|
|
my( $ometa, $otext ) = $this->readTopic( undef, $oldWeb, $oldTopic );
|
|
if( $user &&
|
|
!$this->{session}->{security}->checkAccessPermission
|
|
( 'change', $user, $otext, $ometa, $oldTopic, $oldWeb )) {
|
|
throw TWiki::AccessControlException(
|
|
'CHANGE', $user, $oldWeb, $oldTopic,
|
|
$this->{session}->{security}->getReason());
|
|
}
|
|
|
|
my ( $nmeta, $ntext ) = $this->readTopic( undef, $newWeb, $newTopic );
|
|
if( $user &&
|
|
!$this->{session}->{security}->checkAccessPermission
|
|
( 'change', $user, $ntext, $nmeta, $newTopic, $newWeb )) {
|
|
throw TWiki::AccessControlException(
|
|
'CHANGE', $user, $newWeb, $newTopic,
|
|
$this->{session}->{security}->getReason());
|
|
}
|
|
|
|
# Remove file attachment from old topic
|
|
my $handler =
|
|
$this->_getHandler( $oldWeb, $oldTopic, $oldAttachment );
|
|
|
|
$handler->moveAttachment( $newWeb, $newTopic, $newAttachment );
|
|
|
|
my $fileAttachment =
|
|
$ometa->get( 'FILEATTACHMENT', $oldAttachment );
|
|
$ometa->remove( 'FILEATTACHMENT', $oldAttachment );
|
|
$this->_noHandlersSave( $user, $oldWeb, $oldTopic, $otext, $ometa,
|
|
{ notify => 0 } );
|
|
|
|
# Add file attachment to new topic
|
|
$fileAttachment->{name} = $newAttachment;
|
|
$fileAttachment->{movefrom} = $oldWeb.'.'.$oldTopic.'.'.$oldAttachment;
|
|
$fileAttachment->{moveby} = $user->webDotWikiName();
|
|
$fileAttachment->{movedto} = $newWeb.'.'.$newTopic.'.'.$newAttachment;
|
|
$fileAttachment->{movedwhen} = time();
|
|
$nmeta->putKeyed( 'FILEATTACHMENT', $fileAttachment );
|
|
|
|
$this->_noHandlersSave( $user, $newWeb, $newTopic, $ntext,
|
|
$nmeta, { dontlog => 1,
|
|
notify => 0,
|
|
comment => 'moved' } );
|
|
$this->{session}->writeLog(
|
|
'move',
|
|
$fileAttachment->{movefrom}.' moved to '.
|
|
$fileAttachment->{movedto}, $user->webDotWikiName() );
|
|
} finally {
|
|
$this->unlockTopic( $user, $oldWeb, $oldTopic );
|
|
$this->unlockTopic( $user, $newWeb, $newTopic );
|
|
};
|
|
|
|
# alert plugins of attachment move
|
|
$this->{session}->{plugins}->afterRenameHandler( $oldWeb, $oldTopic, $oldAttachment,
|
|
$newWeb, $newTopic, $newAttachment );
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod getAttachmentStream( $user, $web, $topic, $attName ) -> \*STREAM
|
|
|
|
* =$user= - the user doing the reading, or undef if no access checks
|
|
* =$web= - The web
|
|
* =$topic= - The topic
|
|
* =$attName= - Name of the attachment
|
|
|
|
Open a standard input stream from an attachment.
|
|
|
|
If $user is defined, view permission will be required for the topic
|
|
read to be successful. Access control violations and errors will
|
|
cause exceptions to be thrown.
|
|
|
|
Permissions are checked for the user name passed in.
|
|
|
|
=cut
|
|
|
|
sub getAttachmentStream {
|
|
my ( $this, $user, $web, $topic, $att ) = @_;
|
|
ASSERT($this->isa('TWiki::Store')) if DEBUG;
|
|
|
|
if( $user &&
|
|
!$this->{session}->{security}->checkAccessPermission
|
|
( 'view', $user, undef, undef, $topic, $web )) {
|
|
throw TWiki::AccessControlException( 'VIEW', $user, $web, $topic,
|
|
$this->{session}->{security}->getReason());
|
|
}
|
|
|
|
my $handler = $this->_getHandler( $web, $topic, $att );
|
|
return $handler->getStream();
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod getAttachmentList($web, $topic)
|
|
|
|
returns @($attachmentName => [stat]) for any given web, topic
|
|
|
|
=cut
|
|
|
|
sub getAttachmentList {
|
|
my( $this, $web, $topic ) = @_;
|
|
|
|
ASSERT($this->isa('TWiki::Store')) if DEBUG;
|
|
my $handler = $this->_getHandler( $web, $topic );
|
|
return $handler->getAttachmentList($web, $topic);
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod attachmentExists( $web, $topic, $att ) -> $boolean
|
|
|
|
Determine if the attachment already exists on the given topic
|
|
|
|
=cut
|
|
|
|
sub attachmentExists {
|
|
my( $this, $web, $topic, $att ) = @_;
|
|
|
|
ASSERT($this->isa('TWiki::Store')) if DEBUG;
|
|
my $handler = $this->_getHandler( $web, $topic, $att );
|
|
return $handler->storedDataExists();
|
|
}
|
|
|
|
# _findAttachments($session, $web, $topic, $knownAttachments)
|
|
# Synchronise the attachment list with what's actually on disk
|
|
# Returns an ARRAY of FILEATTACHMENTs- these can be put in the new meta using meta->put('FILEATTACHMENTS', $tree)
|
|
#IDEA On Windows machines where the underlying filesystem can store
|
|
#arbitary meta data against files, this might replace/fulfil the COMMENT
|
|
# purpose
|
|
#TODO consider logging when things are added to metadata
|
|
|
|
|
|
sub _findAttachments {
|
|
my ($this, $web, $topic, $attachmentsKnownInMeta) = @_;
|
|
my $session = $this->{session};
|
|
ASSERT($session->isa( 'TWiki' )) if DEBUG;
|
|
|
|
my $store = $this;
|
|
|
|
my %filesListedInPub = $store->getAttachmentList($web, $topic);
|
|
my %filesListedInMeta = ();
|
|
|
|
# You need the following lines if you want metadata to supplement
|
|
# the filesystem
|
|
if (defined $attachmentsKnownInMeta) {
|
|
%filesListedInMeta =
|
|
TWiki::Meta::indexByKey('name', @$attachmentsKnownInMeta);
|
|
}
|
|
|
|
# Please retain following print until this feature is out of beta
|
|
# print "Topic: $web.$topic:\n";
|
|
# use Data::Dumper;
|
|
# $this->{session}->writeDebug("In Meta:".Dumper(\%filesListedInMeta). "\n\nIn Pub:\n".Dumper(\%filesListedInPub));
|
|
|
|
foreach my $file (keys %filesListedInPub) {
|
|
if ($filesListedInMeta{$file}) {
|
|
# Bring forward any missing yet wanted attributes
|
|
#SMELL: this will over-write (empty) any meta data field not listed here :(
|
|
foreach my $field qw(comment attr user version) {
|
|
if ($filesListedInMeta{$file}{$field}) {
|
|
# $this->{session}->writeDebug("$file: bringing forward field $field: was ".$filesListedInPub{$file}{$field});
|
|
$filesListedInPub{$file}{$field} =
|
|
$filesListedInMeta{$file}{$field};
|
|
# $this->{session}->writeDebug(" now: ".$filesListedInPub{$file}{$field}."\n");
|
|
}
|
|
}
|
|
# Develop:Bugs.Item452 - WHY IS USER STILL WRONG?
|
|
}
|
|
}
|
|
|
|
# Please retain following print until this feature is out of beta
|
|
# use Data::Dumper;
|
|
# $this->{session}->writeDebug("Result:".Dumper(\%filesListedInPub)."\n");
|
|
|
|
# A comparison of the keys of the $filesListedInMeta and %filesListedInPub
|
|
# would show files that were in Meta but have disappeared from Pub.
|
|
|
|
# SMELL Meta really ought index its attachments in a hash by attachment
|
|
# name but this is not the case
|
|
# SMELL: Do not change this from array to hash, you would lose the
|
|
# proper attachment sequence
|
|
my @deindexedBecauseMetaDoesnotIndexAttachments =
|
|
TWiki::Meta::deindexKeyed(%filesListedInPub);
|
|
|
|
return @deindexedBecauseMetaDoesnotIndexAttachments;
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod _removeAutoAttachmentsFromMeta
|
|
|
|
This is where we are going to remove from meta any entry that is marked as an automatic attachment.
|
|
|
|
=cut
|
|
|
|
sub _removeAutoAttachmentsFromMeta {
|
|
my ($this, $meta) = @_;
|
|
# use Data::Dumper;
|
|
# die "removeAutoAttachmentsFromMeta".Dumper($meta);
|
|
return $meta;
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod moveTopic( $oldWeb, $oldTopic, $newWeb, $newTopic, $user )
|
|
|
|
All parameters must be defined and must be untainted.
|
|
|
|
=cut
|
|
|
|
sub moveTopic {
|
|
my( $this, $oldWeb, $oldTopic, $newWeb, $newTopic, $user ) = @_;
|
|
ASSERT($this->isa('TWiki::Store')) if DEBUG;
|
|
ASSERT($user->isa('TWiki::User')) if DEBUG;
|
|
|
|
my $handler = $this->_getHandler( $oldWeb, $oldTopic, '' );
|
|
my $rev = $handler->numRevisions();
|
|
|
|
# will block
|
|
$this->lockTopic( $user, $oldWeb, $oldTopic );
|
|
try {
|
|
my $otext = $this->readTopicRaw( undef, $oldWeb, $oldTopic );
|
|
# Note: undef $meta param will cause $otext to be parsed for meta
|
|
if( $user &&
|
|
!$this->{session}->{security}->checkAccessPermission
|
|
( 'change', $user, $otext, undef, $oldTopic, $oldWeb )) {
|
|
throw TWiki::AccessControlException(
|
|
'CHANGE', $user,
|
|
$oldWeb, $oldTopic,
|
|
$this->{session}->{security}->getReason());
|
|
}
|
|
|
|
my ( $nmeta, $ntext );
|
|
if( $this->topicExists( $newWeb, $newTopic )) {
|
|
( $nmeta, $ntext ) = $this->readTopic( undef, $newWeb, $newTopic );
|
|
}
|
|
if( $user &&
|
|
!$this->{session}->{security}->checkAccessPermission
|
|
( 'change', $user, $ntext, $nmeta, $newTopic, $newWeb )) {
|
|
throw TWiki::AccessControlException(
|
|
'CHANGE', $user, $newWeb, $newTopic,
|
|
$this->{session}->{security}->getReason());
|
|
}
|
|
|
|
$handler->moveTopic( $newWeb, $newTopic );
|
|
} finally {
|
|
$this->unlockTopic( $user, $oldWeb, $oldTopic );
|
|
};
|
|
|
|
if( $newWeb ne $oldWeb ) {
|
|
# Record that it was moved away
|
|
$this->_recordChange( $oldWeb, $oldTopic, $user, $rev );
|
|
}
|
|
|
|
$this->_recordChange( $newWeb, $newTopic, $user, $rev );
|
|
|
|
# Log rename
|
|
if( $TWiki::cfg{Log}{rename} ) {
|
|
my $old = $oldWeb.'.'.$oldTopic;
|
|
my $new = $newWeb.'.'.$newTopic;
|
|
$this->{session}->writeLog( 'rename', $old, "moved to $new", $user );
|
|
}
|
|
|
|
# alert plugins of topic move
|
|
$this->{session}->{plugins}->afterRenameHandler( $oldWeb, $oldTopic, '',
|
|
$newWeb, $newTopic, '' );
|
|
}
|
|
|
|
# update .changes for statistics and mailer
|
|
sub _recordChange {
|
|
my( $this, $web, $topic, $user, $rev, $more ) = @_;
|
|
$more ||= '';
|
|
my @foo = map { my @row = split(/\t/, $_); \@row }
|
|
split( /[\r\n]+/, $this->readMetaData( $web, 'changes' ));
|
|
# SMELL: make the 500 configurable? Or trim on the basis of age?
|
|
shift( @foo) if( $#foo > 500 );
|
|
push( @foo, [ $topic, $user->login(), time(), $rev, $more ] );
|
|
$this->saveMetaData(
|
|
$web, 'changes',
|
|
join( "\n",
|
|
map { join( "\t", @$_); } @foo ));
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod moveWeb( $oldWeb, $newWeb, $user )
|
|
|
|
Move a web.
|
|
|
|
All parrameters must be defined and must be untainted.
|
|
|
|
=cut
|
|
|
|
sub moveWeb {
|
|
my( $this, $oldWeb, $newWeb, $user ) = @_;
|
|
ASSERT($this->isa('TWiki::Store')) if DEBUG;
|
|
ASSERT($user->isa('TWiki::User')) if DEBUG;
|
|
|
|
$oldWeb =~ s/\./\//go;
|
|
$newWeb =~ s/\./\//go;
|
|
|
|
my (@webList) = $this->getListOfWebs('public', $oldWeb);
|
|
unshift(@webList,$oldWeb);
|
|
foreach my $webIter (@webList) {
|
|
if( $webIter ) {
|
|
my @webTopicList = $this->getTopicNames( $webIter );
|
|
foreach my $webTopic (@webTopicList) {
|
|
$this->lockTopic( $user, $webIter, $webTopic );
|
|
}
|
|
}
|
|
}
|
|
|
|
my @newParentPath = split(/\//,$newWeb);
|
|
pop( @newParentPath );
|
|
my $newParent = join( '/', @newParentPath );
|
|
|
|
my $handler = $this->_getHandler( $oldWeb );
|
|
$handler->moveWeb( $newWeb );
|
|
|
|
(@webList) = $this->getListOfWebs('public', $newWeb);
|
|
unshift(@webList, $newWeb);
|
|
foreach my $webIter (@webList) {
|
|
if( $webIter ) {
|
|
my @webTopicList = $this->getTopicNames( $webIter );
|
|
foreach my $webTopic (@webTopicList) {
|
|
$this->unlockTopic( $user, $webIter, $webTopic );
|
|
}
|
|
}
|
|
}
|
|
|
|
# Log rename
|
|
if( $TWiki::cfg{Log}{rename} ) {
|
|
$this->{session}->writeLog( 'renameweb', $oldWeb, 'moved to '.$newWeb, $user );
|
|
}
|
|
|
|
# alert plugins of web move
|
|
$this->{session}->{plugins}->afterRenameHandler( $oldWeb, '', '', $newWeb, '', '' );
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod readAttachment( $user, $web, $topic, $attachment, $theRev ) -> $text
|
|
|
|
Read the given version of an attachment, returning the content.
|
|
|
|
View permission on the topic is required for the
|
|
read to be successful. Access control violations are flagged by a
|
|
TWiki::AccessControlException. Permissions are checked for the user
|
|
passed in.
|
|
|
|
If $theRev is not given, the most recent rev is assumed.
|
|
|
|
=cut
|
|
|
|
sub readAttachment {
|
|
my ( $this, $user, $web, $topic, $attachment, $theRev ) = @_;
|
|
|
|
ASSERT($this->isa('TWiki::Store')) if DEBUG;
|
|
|
|
if( $user &&
|
|
!$this->{session}->{security}->checkAccessPermission
|
|
( 'view', $user, undef, undef, $topic, $web )) {
|
|
throw TWiki::AccessControlException(
|
|
'VIEW', $user, $web, $topic,
|
|
$this->{session}->{security}->getReason());
|
|
}
|
|
|
|
my $handler = $this->_getHandler( $web, $topic, $attachment );
|
|
return $handler->getRevision( $theRev );
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod getRevisionNumber ( $web, $topic, $attachment ) -> $integer
|
|
|
|
Get the revision number of the most recent revision. Returns
|
|
the integer revision number or '' if the topic doesn't exist.
|
|
|
|
WORKS FOR ATTACHMENTS AS WELL AS TOPICS
|
|
|
|
=cut
|
|
|
|
sub getRevisionNumber {
|
|
my( $this, $web, $topic, $attachment ) = @_;
|
|
ASSERT($this->isa('TWiki::Store')) if DEBUG;
|
|
|
|
$attachment = '' unless $attachment;
|
|
|
|
my $handler = $this->_getHandler( $web, $topic, $attachment );
|
|
return $handler->numRevisions();
|
|
}
|
|
|
|
=pod
|
|
|
|
---+++ ObjectMethod getWorkArea( $key ) -> $directorypath
|
|
|
|
Gets a private directory uniquely identified by $key. The directory is
|
|
intended as a work area for plugins. The directory will exist.
|
|
|
|
=cut
|
|
|
|
sub getWorkArea {
|
|
my( $this, $key ) = @_;
|
|
|
|
my $handler = $this->_getHandler( );
|
|
return $handler->getWorkArea( $key );
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod getRevisionDiff ( $user, $web, $topic, $rev1, $rev2, $contextLines ) -> \@diffArray
|
|
|
|
Return reference to an array of [ diffType, $right, $left ]
|
|
* =$user= - the user object, or undef to suppress access control checks
|
|
* =$web= - the web
|
|
* =$topic= - the topic
|
|
* =$rev1= Integer revision number
|
|
* =$rev2= Integer revision number
|
|
* =$contextLines= - number of lines of context required
|
|
|
|
=cut
|
|
|
|
sub getRevisionDiff {
|
|
my( $this, $user, $web, $topic, $rev1, $rev2, $contextLines ) = @_;
|
|
ASSERT($this->isa('TWiki::Store')) if DEBUG;
|
|
ASSERT(defined($contextLines)) if DEBUG;
|
|
if( $user ) {
|
|
my $r1;
|
|
try {
|
|
# Make sure both revs are readable.
|
|
$r1 = $this->readTopicRaw( $user, $web, $topic, $rev1 );
|
|
} catch TWiki::AccessControlException with {
|
|
$r1 = undef;
|
|
};
|
|
my $r2;
|
|
try {
|
|
$r2 = $this->readTopicRaw( $user, $web, $topic, $rev2 );
|
|
} catch TWiki::AccessControlException with {
|
|
$r2 = undef;
|
|
};
|
|
my $rd;
|
|
if( !defined( $r1 )) {
|
|
$rd = [[ '-', " *Revision $rev1 is unreadable* ", '' ]];
|
|
if( !defined( $r2 )) {
|
|
push( @$rd, [ '+', '', " *Revision $rev2 is unreadable* " ] );
|
|
} else {
|
|
foreach ( split( /\r?\n/, $r2 )) {
|
|
push( @$rd, [ '+', '', $_ ] );
|
|
}
|
|
}
|
|
} elsif( !defined( $r2 )) {
|
|
$rd = [[ '+', '', " *Revision $rev2 is unreadable* " ]];
|
|
foreach ( split( /\r?\n/, $r1 )) {
|
|
push( @$rd, [ '-', $_, '' ] );
|
|
}
|
|
}
|
|
return $rd if $rd;
|
|
}
|
|
|
|
my $rcs = $this->_getHandler( $web, $topic );
|
|
return $rcs->revisionDiff( $rev1, $rev2, $contextLines );
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod getRevisionInfo($web, $topic, $rev, $attachment) -> ( $date, $user, $rev, $comment )
|
|
|
|
Get revision info of a topic.
|
|
* =$web= Web name, optional, e.g. ='Main'=
|
|
* =$topic= Topic name, required, e.g. ='TokyoOffice'=
|
|
* =$rev= revision number. If 0, undef, or out-of-range, will get info about the most recent revision.
|
|
* =$attachment= attachment filename; undef for a topic
|
|
Return list with: ( last update date, last user object, =
|
|
| $date | in epochSec |
|
|
| $user | user *object* |
|
|
| $rev | the revision number |
|
|
| $comment | WHAT COMMENT? |
|
|
e.g. =( 1234561, 'phoeny', 5, 'no comment' )
|
|
|
|
NOTE NOTE NOTE if you are working within the TWiki code DO NOT USE THIS
|
|
FUNCTION FOR GETTING REVISION INFO OF TOPICS - use
|
|
TWiki::Meta::getRevisionInfo instead. This is essential to allow clean
|
|
transition to a topic object model later, and avoids the risk of confusion
|
|
coming from meta and Store revision information being out of step.
|
|
(it's OK to use it for attachments)
|
|
|
|
=cut
|
|
|
|
sub getRevisionInfo {
|
|
my( $this, $web, $topic, $rev, $attachment ) = @_;
|
|
ASSERT($this->isa('TWiki::Store')) if DEBUG;
|
|
|
|
$rev ||= 0;
|
|
|
|
my $handler =
|
|
$this->_getHandler( $web, $topic, $attachment );
|
|
|
|
my( $rrev, $date, $user, $comment ) =
|
|
$handler->getRevisionInfo( $rev );
|
|
$rev = $rrev;
|
|
|
|
$user = $this->{session}->{users}->findUser( $user ) if $user;
|
|
|
|
return ( $date, $user, $rev, $comment );
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ StaticMethod dataEncode( $uncoded ) -> $coded
|
|
|
|
Encode meta-data fields, escaping out selected characters. The encoding
|
|
is chosen to avoid problems with parsing the attribute values, while
|
|
minimising the number of characters encoded so searches can still work
|
|
(fairly) sensibly.
|
|
|
|
The encoding has to be exported because TWiki (and plugins) use
|
|
encoded field data in other places e.g. RDiff, mainly as a shorthand
|
|
for the properly parsed meta object. Some day we may be able to
|
|
eliminate that....
|
|
|
|
=cut
|
|
|
|
sub dataEncode {
|
|
my $datum = shift;
|
|
|
|
$datum =~ s/([%"\r\n{}])/'%'.sprintf('%02x',ord($1))/ge;
|
|
return $datum;
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ StaticMethod dataDecode( $encoded ) -> $decoded
|
|
|
|
Decode escapes in a string that was encoded using dataEncode
|
|
|
|
The encoding has to be exported because TWiki (and plugins) use
|
|
encoded field data in other places e.g. RDiff, mainly as a shorthand
|
|
for the properly parsed meta object. Some day we may be able to
|
|
eliminate that....
|
|
|
|
=cut
|
|
|
|
sub dataDecode {
|
|
my $datum = shift;
|
|
|
|
$datum =~ s/%([\da-f]{2})/chr(hex($1))/gei;
|
|
return $datum;
|
|
}
|
|
|
|
# STATIC Build a hash by parsing name=value comma separated pairs
|
|
# SMELL: duplication of TWiki::Attrs, using a different
|
|
# system of escapes :-(
|
|
sub _readKeyValues {
|
|
my( $args, $format ) = @_;
|
|
my $res = {};
|
|
|
|
$format =~ s/[^\d\.]+//g if $format;
|
|
my $oldStyle = ( !$format || $format =~ /[^\d.]/ || $format < 1.1 );
|
|
|
|
# Format of data is name='value' name1='value1' [...]
|
|
$args =~ s/\s*([^=]+)="([^"]*)"/_singleKey($1,$2,$res,$oldStyle)/ge;
|
|
|
|
return $res;
|
|
}
|
|
|
|
sub _singleKey {
|
|
my( $key, $value, $res, $oldStyle ) = @_;
|
|
|
|
if( $oldStyle ) {
|
|
# Old decoding retained for backward compatibility
|
|
# (this encoding is badly broken)
|
|
$value =~ s/%_N_%/\n/g;
|
|
$value =~ s/%_Q_%/\"/g;
|
|
$value =~ s/%_P_%/%/g;
|
|
} else {
|
|
$value = dataDecode( $value );
|
|
}
|
|
|
|
$res->{$key} = $value;
|
|
|
|
return '';
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod saveTopic( $user, $web, $topic, $text, $meta, $options )
|
|
|
|
* =$user= - user doing the saving (object)
|
|
* =$web= - web for topic
|
|
* =$topic= - topic to atach to
|
|
* =$text= - topic text
|
|
* =$meta= - topic meta-data
|
|
* =$options= - Ref to hash of options
|
|
=$options= may include:
|
|
| =dontlog= | don't log this change in twiki log |
|
|
| =hide= | if the attachment is to be hidden in normal topic view |
|
|
| =comment= | comment for save |
|
|
| =file= | Temporary file name to upload |
|
|
| =minor= | True if this is a minor change (used in log) |
|
|
| =savecmd= | Save command |
|
|
| =forcedate= | grr |
|
|
| =unlock= | |
|
|
|
|
Save a new revision of the topic, calling plugins handlers as appropriate.
|
|
|
|
=cut
|
|
|
|
sub saveTopic {
|
|
my( $this, $user, $web, $topic, $text, $meta, $options ) = @_;
|
|
ASSERT($this->isa('TWiki::Store')) if DEBUG;
|
|
ASSERT($user->isa('TWiki::User')) if DEBUG;
|
|
$web =~ s#\.#/#go;
|
|
$meta = $this->_removeAutoAttachmentsFromMeta($meta);
|
|
|
|
$options = {} unless defined( $options );
|
|
|
|
if( $user &&
|
|
!$this->{session}->{security}->checkAccessPermission
|
|
( 'change', $user, undef, undef, $topic, $web )) {
|
|
|
|
throw TWiki::AccessControlException(
|
|
'CHANGE', $user, $web, $topic,
|
|
$this->{session}->{security}->getReason());
|
|
}
|
|
my $plugins = $this->{session}->{plugins};
|
|
# Semantics inherited from Cairo. See
|
|
# TWiki:Codev.BugBeforeSaveHandlerBroken
|
|
if( $plugins->haveHandlerFor( 'beforeSaveHandler' )) {
|
|
my $before = '';
|
|
if( $meta ) {
|
|
# write the meta into the topic text. Nasty compatibility
|
|
# requirement.
|
|
$text = _writeMeta( $meta, $text );
|
|
$before = $meta->stringify();
|
|
}
|
|
$plugins->beforeSaveHandler( $text, $topic, $web, $meta );
|
|
# remove meta again
|
|
my $after = new TWiki::Meta( $this->{session}, $web, $topic);
|
|
$this->extractMetaData( $after, \$text );
|
|
# If there are no changes in the $meta object, take the meta
|
|
# from the text. Nasty compatibility requirement.
|
|
if( !$meta || $meta->stringify() eq $before ){
|
|
$meta = $after;
|
|
}
|
|
}
|
|
my $error;
|
|
try {
|
|
$this->_noHandlersSave( $user, $web, $topic, $text, $meta, $options );
|
|
} catch Error::Simple with {
|
|
$error = shift;
|
|
};
|
|
|
|
# Semantics inherited from Cairo. See
|
|
# TWiki:Codev.BugBeforeSaveHandlerBroken
|
|
if( $plugins->haveHandlerFor( 'afterSaveHandler' )) {
|
|
if( $meta ) {
|
|
$text = _writeMeta( $meta, $text );
|
|
}
|
|
$plugins->afterSaveHandler( $text, $topic, $web,
|
|
$error?$error->{-text}:'', $meta );
|
|
}
|
|
|
|
throw $error if $error;
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod saveAttachment ($web, $topic, $attachment, $user, $opts )
|
|
|
|
* =$user= - user doing the saving
|
|
* =$web= - web for topic
|
|
* =$topic= - topic to atach to
|
|
* =$attachment= - name of the attachment
|
|
* =$opts= - Ref to hash of options
|
|
=$opts= may include:
|
|
| =dontlog= | don't log this change in twiki log |
|
|
| =comment= | comment for save |
|
|
| =hide= | if the attachment is to be hidden in normal topic view |
|
|
| =stream= | Stream of file to upload |
|
|
| =file= | Name of a file to use for the attachment data. ignored is stream is set. |
|
|
| =filepath= | Client path to file |
|
|
| =filesize= | Size of uploaded data |
|
|
| =filedate= | Date |
|
|
|
|
Saves a new revision of the attachment, invoking plugin handlers as
|
|
appropriate.
|
|
|
|
If file is not set, this is a properties-only save.
|
|
|
|
=cut
|
|
|
|
sub saveAttachment {
|
|
my( $this, $web, $topic, $attachment, $user, $opts ) = @_;
|
|
ASSERT($this->isa('TWiki::Store')) if DEBUG;
|
|
ASSERT($user->isa('TWiki::User')) if DEBUG;
|
|
ASSERT(defined($opts)) if DEBUG;
|
|
my $action;
|
|
my $plugins = $this->{session}->{plugins};
|
|
my $attrs;
|
|
|
|
$this->lockTopic( $user, $web, $topic );
|
|
|
|
try {
|
|
# update topic
|
|
my( $meta, $text ) = $this->readTopic( undef, $web, $topic, undef );
|
|
|
|
if( $user &&
|
|
!$this->{session}->{security}->checkAccessPermission
|
|
( 'change', $user, $text, $meta, $topic, $web )) {
|
|
|
|
throw TWiki::AccessControlException(
|
|
'CHANGE', $user, $web, $topic,
|
|
$this->{session}->{security}->getReason());
|
|
}
|
|
|
|
if( $opts->{file} && !$opts->{stream} ) {
|
|
open($opts->{stream}, "<$opts->{file}") ||
|
|
throw Error::Simple('Could not open '.$opts->{file} );
|
|
binmode($opts->{stream}) ||
|
|
throw Error::Simple( $opts->{file}.' binmode failed: '.$! );
|
|
}
|
|
if ( $opts->{stream} ) {
|
|
$action = 'upload';
|
|
|
|
$attrs = {
|
|
attachment => $attachment,
|
|
stream => $opts->{stream},
|
|
user => $user->webDotWikiName()
|
|
};
|
|
$attrs->{comment} = $opts->{comment}
|
|
if (defined($opts->{comment}));
|
|
|
|
my $handler = $this->_getHandler( $web, $topic, $attachment );
|
|
|
|
my $tmpFile;
|
|
|
|
if( $plugins->haveHandlerFor( 'beforeAttachmentSaveHandler' )) {
|
|
# SMELL: legacy spec of beforeAttachmentSaveHandler requires
|
|
# a local copy of the stream. This could be a problem for
|
|
# very big data files.
|
|
use File::Temp;
|
|
my $fh;
|
|
# Note: do *not* rely on UNLINK => 1, because in a mod_perl
|
|
# context the destructor may not be called for a *long* time.
|
|
# Call tempfile in a list context so that file does not get
|
|
# deleted when closed.
|
|
( $fh, $tmpFile ) = File::Temp::tempfile();
|
|
binmode( $fh );
|
|
# transfer 512KB blocks
|
|
my $transfer;
|
|
my $r;
|
|
while( $r = sysread( $opts->{stream}, $transfer, 0x80000 )) {
|
|
syswrite( $fh, $transfer, $r );
|
|
}
|
|
close( $fh );
|
|
$attrs->{tmpFilename} = $tmpFile;
|
|
$plugins->beforeAttachmentSaveHandler( $attrs, $topic, $web );
|
|
open( $opts->{stream}, "<$tmpFile" );
|
|
binmode( $opts->{stream} );
|
|
}
|
|
my $error;
|
|
try {
|
|
$handler->addRevisionFromStream( $opts->{stream},
|
|
$opts->{comment},
|
|
$user->wikiName() );
|
|
} catch Error::Simple with {
|
|
$error = shift;
|
|
};
|
|
|
|
unlink( $tmpFile ) if( $tmpFile && -e $tmpFile );
|
|
|
|
if( $plugins->haveHandlerFor( 'afterAttachmentSaveHandler' )) {
|
|
$plugins->afterAttachmentSaveHandler( $attrs, $topic, $web,
|
|
$error ?
|
|
$error->{-text} : '' );
|
|
}
|
|
throw $error if $error;
|
|
|
|
$attrs->{name} ||= $attachment;
|
|
my $fileVersion = $this->getRevisionNumber( $web, $topic,
|
|
$attachment );
|
|
$attrs->{version} = $fileVersion;
|
|
$attrs->{path} = $opts->{filepath} if (defined($opts->{filepath}));
|
|
$attrs->{size} = $opts->{filesize} if (defined($opts->{filesize}));
|
|
$attrs->{date} = $opts->{filedate} if (defined($opts->{filedate}));
|
|
$attrs->{attr} = ( $opts->{hide} ) ? 'h' : '';
|
|
|
|
$meta->putKeyed( 'FILEATTACHMENT', $attrs );
|
|
} else {
|
|
$action = 'save';
|
|
$attrs = $meta->get( 'FILEATTACHMENT', $attachment );
|
|
$attrs->{name} = $attachment;
|
|
$attrs->{attr} = ( $opts->{hide} ) ? 'h' : '';
|
|
$attrs->{comment} = $opts->{comment} if (defined($opts->{comment}));
|
|
$meta->putKeyed( 'FILEATTACHMENT', $attrs );
|
|
}
|
|
|
|
if( $opts->{createlink} ) {
|
|
$text .= $this->{session}->{attach}->getAttachmentLink(
|
|
$user, $web, $topic, $attachment, $meta );
|
|
}
|
|
|
|
$this->saveTopic( $user, $web, $topic, $text, $meta, {} );
|
|
|
|
} finally {
|
|
$this->unlockTopic( $user, $web, $topic );
|
|
};
|
|
|
|
if ( ( ! $opts->{dontlog} ) && ( $TWiki::cfg{Log}{$action} ) ) {
|
|
$this->{session}->writeLog( $action, $web.'.'.$topic, $attachment, $user );
|
|
}
|
|
}
|
|
|
|
# Save a topic or attachment _without_ invoking plugin handlers.
|
|
# FIXME: does rev info from meta work if user saves a topic with no change?
|
|
sub _noHandlersSave {
|
|
my( $this, $user, $web, $topic, $text, $meta, $options ) = @_;
|
|
|
|
ASSERT($user->isa('TWiki::User')) if DEBUG;
|
|
|
|
$meta ||= new TWiki::Meta( $this->{session}, $web, $topic );
|
|
|
|
my $handler = $this->_getHandler( $web, $topic );
|
|
my $currentRev = $handler->numRevisions() || 0;
|
|
my $nextRev = $currentRev + 1;
|
|
|
|
if( $currentRev && !$options->{forcenewrevision} ) {
|
|
# See if we want to replace the existing top revision
|
|
my $mtime1 = $handler->getTimestamp();
|
|
my $mtime2 = time();
|
|
|
|
if( abs( $mtime2 - $mtime1 ) <
|
|
$TWiki::cfg{ReplaceIfEditedAgainWithin} ) {
|
|
|
|
my( $rev, $date, $revuser, $comment ) =
|
|
$handler->getRevisionInfo( $currentRev );
|
|
|
|
# same user?
|
|
if( $revuser eq $user->wikiName() ) {
|
|
$this->repRev( $user, $web, $topic, $text,
|
|
$meta, $options );
|
|
return;
|
|
}
|
|
}
|
|
}
|
|
|
|
if( $meta ) {
|
|
addTOPICINFO( $meta, $nextRev, time(), $user, 0 );
|
|
$text = _writeMeta( $meta, $text );
|
|
}
|
|
|
|
# will block
|
|
$this->lockTopic( $user, $web, $topic );
|
|
|
|
try {
|
|
$handler->addRevisionFromText( $text, $options->{comment},
|
|
$user->wikiName() );
|
|
# just in case they are not sequential
|
|
$nextRev = $handler->numRevisions();
|
|
|
|
my $extra = $options->{minor} ? 'minor' : '';
|
|
$this->_recordChange( $web, $topic, $user, $nextRev, $extra );
|
|
|
|
if( ( $TWiki::cfg{Log}{save} ) && ! ( $options->{dontlog} ) ) {
|
|
$this->{session}->writeLog( 'save', $web.'.'.$topic,
|
|
$extra, $user );
|
|
}
|
|
} finally {
|
|
$this->unlockTopic( $user, $web, $topic );
|
|
};
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod repRev( $user, $web, $topic, $text, $meta, $options )
|
|
|
|
Replace last (top) revision with different text.
|
|
|
|
Parameters and return value as saveTopic, except
|
|
* =$options= - as for saveTopic, with the extra option:
|
|
* =timetravel= - if we want to force the deposited revision to look as much like the revision specified in =$rev= as possible.
|
|
* =operation= - set to the name of the operation performing the save. This is used only in the log, and is normally =cmd= or =save=. It defaults to =save=.
|
|
|
|
Used to try to avoid the deposition of 'unecessary' revisions, for example
|
|
where a user quickly goes back and fixes a spelling error.
|
|
|
|
Also provided as a means for administrators to rewrite history (timetravel).
|
|
|
|
It is up to the store implementation if this is different
|
|
to a normal save or not.
|
|
|
|
=cut
|
|
|
|
sub repRev {
|
|
my( $this, $user, $web, $topic, $text, $meta, $options ) = @_;
|
|
|
|
ASSERT($meta && $meta->isa('TWiki::Meta')) if DEBUG;
|
|
|
|
my( $revdate, $revuser, $rev ) = $meta->getRevisionInfo();
|
|
|
|
# RCS requires a newline for the last line,
|
|
$text .= "\n" unless $text =~ /\n$/s;
|
|
|
|
if( $options->{timetravel} ) {
|
|
# We are trying to force the rev to be saved with the same date
|
|
# and user as the prior rev. However, exactly the same date may
|
|
# cause some revision control systems to barf, so to avoid this we
|
|
# add 1 minute to the rev time. Note that this mode of operation
|
|
# will normally require sysadmin privilege, as it can result in
|
|
# confused rev dates if abused.
|
|
$revdate += 60;
|
|
} else {
|
|
# use defaults (current time, current user)
|
|
$revdate = time();
|
|
$revuser = $user;
|
|
}
|
|
addTOPICINFO( $meta, $rev, $revdate, $revuser, 1 );
|
|
|
|
$text = _writeMeta( $meta, $text );
|
|
|
|
$this->lockTopic( $user, $web, $topic );
|
|
try {
|
|
my $handler = $this->_getHandler( $web, $topic );
|
|
$handler->replaceRevision( $text, $options->{comment},
|
|
$revuser->wikiName(), $revdate );
|
|
} finally {
|
|
$this->unlockTopic( $user, $web, $topic );
|
|
};
|
|
|
|
if( ( $TWiki::cfg{Log}{save} ) && ! ( $options->{dontlog} ) ) {
|
|
# write log entry
|
|
my $extra = "repRev $rev by " . $revuser->login() .
|
|
' '. TWiki::Time::formatTime( $revdate, '$rcs', 'gmtime' );
|
|
$extra .= ' minor' if( $options->{minor} );
|
|
$this->{session}->writeLog( $options->{operation} || 'save',
|
|
$web.'.'.$topic, $extra, $user );
|
|
}
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod delRev( $user, $web, $topic, $text, $meta, $options )
|
|
|
|
Parameters and return value as saveTopic.
|
|
|
|
Provided as a means for administrators to rewrite history.
|
|
|
|
Delete last entry in repository, restoring the previous
|
|
revision.
|
|
|
|
It is up to the store implementation whether this actually
|
|
does delete a revision or not; some implementations will
|
|
simply promote the previous revision up to the head.
|
|
|
|
=cut
|
|
|
|
sub delRev {
|
|
my( $this, $user, $web, $topic ) = @_;
|
|
|
|
my $rev = $this->getRevisionNumber( $web, $topic );
|
|
if( $rev <= 1 ) {
|
|
throw Error::Simple( 'Cannot delete initial revision of '.
|
|
$web.'.'.$topic );
|
|
}
|
|
|
|
$this->lockTopic( $user, $web, $topic );
|
|
try {
|
|
my $handler = $this->_getHandler( $web, $topic );
|
|
$handler->deleteRevision();
|
|
|
|
# restore last topic from repository
|
|
$handler->restoreLatestRevision($user->{wikiname});
|
|
} finally {
|
|
$this->unlockTopic( $user, $web, $topic );
|
|
};
|
|
|
|
# TODO: delete entry in .changes
|
|
|
|
# write log entry
|
|
$this->{session}->writeLog( 'cmd', $web.'.'.$topic, 'delRev by '.
|
|
$user->login().": $rev", $user );
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod lockTopic( $web, $topic )
|
|
|
|
Grab a topic lock on the given topic. A topic lock will cause other
|
|
processes that also try to claim a lock to block. A lock has a
|
|
maximum lifetime of 2 minutes, so operations on a locked topic
|
|
must be completed within that time. You cannot rely on the
|
|
lock timeout clearing the lock, though; that should always
|
|
be done by calling unlockTopic. The best thing to do is to guard
|
|
the locked section with a try..finally clause. See man Error for more info.
|
|
|
|
Topic locks are used to make store operations atomic. They are
|
|
_note_ the locks used when a topic is edited; those are Leases
|
|
(see =getLease=)
|
|
|
|
=cut
|
|
|
|
sub lockTopic {
|
|
my ( $this, $locker, $web, $topic ) = @_;
|
|
ASSERT($this->isa('TWiki::Store')) if DEBUG;
|
|
ASSERT($locker->isa('TWiki::User')) if DEBUG;
|
|
ASSERT($web && $topic) if DEBUG;
|
|
|
|
my $handler = $this->_getHandler( $web, $topic );
|
|
|
|
while ( 1 ) {
|
|
my ( $user, $time ) = $handler->isLocked();
|
|
last if ( !$user || $locker->wikiName() eq $user );
|
|
$this->{session}->writeWarning( "Lock on $web.$topic for ".
|
|
$locker->wikiName().
|
|
" denied by $user" );
|
|
# see how old the lock is. If it's older than 2 minutes,
|
|
# break it anyway. Locks are atomic, and should never be
|
|
# held that long, by _any_ process.
|
|
if ( time() - $time > 2 * 60 ) {
|
|
$this->{session}->writeWarning
|
|
( $locker->wikiName()." broke ${user}s lock on $web.$topic" );
|
|
$handler->setLock( 0 );
|
|
last;
|
|
}
|
|
# wait a couple of seconds before trying again
|
|
sleep(2);
|
|
}
|
|
|
|
$handler->setLock( 1, $locker->wikiName() );
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod unlockTopic( $user, $web, $topic )
|
|
|
|
Release the topic lock on the given topic. A topic lock will cause other
|
|
processes that also try to claim a lock to block. It is important to
|
|
release a topic lock after a guard section is complete. This should
|
|
normally be done in a 'finally' block. See man Error for more info.
|
|
|
|
Topic locks are used to make store operations atomic. They are
|
|
_note_ the locks used when a topic is edited; those are Leases
|
|
(see =getLease=)
|
|
|
|
=cut
|
|
|
|
sub unlockTopic {
|
|
my ( $this, $user, $web, $topic ) = @_;
|
|
ASSERT($this->isa('TWiki::Store')) if DEBUG;
|
|
ASSERT($user->isa('TWiki::User')) if DEBUG;
|
|
|
|
my $handler = $this->_getHandler( $web, $topic );
|
|
$handler->setLock( 0, $user->wikiName() );
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod webExists( $web ) -> $boolean
|
|
|
|
Test if web exists
|
|
* =$web= - Web name, required, e.g. ='Sandbox'=
|
|
|
|
A web _has_ to have a home topic to be a web.
|
|
|
|
=cut
|
|
|
|
sub webExists {
|
|
my( $this, $web ) = @_;
|
|
ASSERT($this->isa('TWiki::Store')) if DEBUG;
|
|
$web =~ s#\.#/#go;
|
|
|
|
return 0 unless defined $web;
|
|
my $handler = $this->_getHandler( $web, $TWiki::cfg{WebPrefsTopicName} );
|
|
return $handler->storedDataExists();
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod topicExists( $web, $topic ) -> $boolean
|
|
|
|
Test if topic exists
|
|
* =$web= - Web name, optional, e.g. ='Main'=
|
|
* =$topic= - Topic name, required, e.g. ='TokyoOffice'=, or ="Main.TokyoOffice"=
|
|
|
|
=cut
|
|
|
|
sub topicExists {
|
|
my( $this, $web, $topic ) = @_;
|
|
$web =~ s#\.#/#go;
|
|
ASSERT($this->isa('TWiki::Store')) if DEBUG;
|
|
ASSERT(defined($topic)) if DEBUG;
|
|
|
|
return 0 unless $topic;
|
|
|
|
my $handler = $this->_getHandler( $web, $topic );
|
|
return $handler->storedDataExists();
|
|
}
|
|
|
|
# Expect meta data at top of file, but willing to accept it anywhere.
|
|
# If we have an old file format without meta data, then convert.
|
|
#
|
|
# If autoattachments is on then get this from the filestore rather than meta data
|
|
#
|
|
# SMELL: SIDE-EFFECTING FUNCTION meta-data is stripped from the $rtext
|
|
#
|
|
# SMELL: Calls to this method from outside of Store
|
|
# should be avoided at all costs, as it exports the assumption that
|
|
# meta-data is embedded in text.
|
|
#
|
|
sub extractMetaData {
|
|
my( $this, $meta, $rtext ) = @_;
|
|
ASSERT($this->isa('TWiki::Store')) if DEBUG;
|
|
ASSERT(defined($$rtext)) if DEBUG;
|
|
|
|
my $format = $STORE_FORMAT_VERSION;
|
|
# head meta-data
|
|
$$rtext =~ s(^%META:TOPICINFO{(.*)}%\r?\n)
|
|
($meta->put( 'TOPICINFO', _readKeyValues( $1 ));'')gem;
|
|
|
|
my $ti = $meta->get( 'TOPICINFO' );
|
|
if( $ti ) {
|
|
$format = $ti->{format} || $STORE_FORMAT_VERSION;
|
|
# Make sure we update the topic format
|
|
$ti->{format} = $STORE_FORMAT_VERSION;
|
|
}
|
|
|
|
my $endMeta = 0;
|
|
|
|
$$rtext =~ s(^%META:([^{]+){(.*)}%\r?\n)
|
|
($endMeta=1;$meta->putKeyed( $1, _readKeyValues( $2, $format )),'')gem;
|
|
|
|
# eat the extra newline put in to separate text from tail meta-data
|
|
$$rtext =~ s/\n$//s if $endMeta;
|
|
|
|
# If there is no meta data then convert from old format
|
|
if( ! $meta->count( 'TOPICINFO' ) ) {
|
|
if ( $$rtext =~ /<!--TWikiAttachment-->/ ) {
|
|
$$rtext = $this->{session}->{attach}->migrateToFileAttachmentMacro( $meta,
|
|
$$rtext );
|
|
}
|
|
|
|
if ( $$rtext =~ /<!--TWikiCat-->/ ) {
|
|
require TWiki::Compatibility;
|
|
$$rtext = TWiki::Compatibility::upgradeCategoryTable( $this->{session}, $meta->web(), $meta->topic(),
|
|
$meta, $$rtext );
|
|
}
|
|
} elsif( $format eq '1.0beta' ) {
|
|
# This format used live at DrKW for a few months
|
|
if( $$rtext =~ /<!--TWikiCat-->/ ) {
|
|
require TWiki::Compatibility;
|
|
$$rtext = TWiki::Compatibility::upgradeCategoryTable( $this->{session}, $meta->web(), $meta->topic(),
|
|
$meta,
|
|
$$rtext );
|
|
}
|
|
$this->{session}->{attach}->upgradeFrom1v0beta( $meta );
|
|
if( $meta->count( 'TOPICMOVED' ) ) {
|
|
my $moved = $meta->get( 'TOPICMOVED' );
|
|
my $u = $this->{session}->{users}->findUser( $moved->{by} );
|
|
$moved->{by} = $u->wikiName() if $u;
|
|
$meta->put( 'TOPICMOVED', $moved );
|
|
}
|
|
}
|
|
|
|
$format =~ s/[^\d\.]//g;
|
|
if( $format && $format < 1.1 ) {
|
|
# compatibility; topics version 1.0 and earlier equivalenced tab
|
|
# with three spaces. Respect that.
|
|
$$rtext =~ s/\t/ /g;
|
|
}
|
|
|
|
return $meta;
|
|
}
|
|
|
|
sub _extractMetaDataAutoAttachments {
|
|
my( $this, $user, $web, $topic, $version, $meta ) = @_;
|
|
if ($TWiki::cfg{AutoAttachPubFiles}) {
|
|
|
|
# $this->{session}->writeDebug("$web.$topic META: ".Dumper($meta->{'FILEATTACHMENT'})."\n".Dumper($this));
|
|
|
|
# TODO need to ensure that this is not called for every topic examined, but rather just the one we are specifically interested in
|
|
# return unless ("$web.$topic" eq $this->{session}{webName}.".".$this->{session}{topicName});
|
|
|
|
my @knownAttachments = $meta->find('FILEATTACHMENT');
|
|
my $ka = undef; #ugly I know
|
|
if ($#knownAttachments) {
|
|
$ka = \@knownAttachments;
|
|
}
|
|
|
|
|
|
|
|
# use Data::Dumper;
|
|
# $Data::Dumper::Maxdepth = 2;
|
|
# $this->{session}->writeDebug("$web.$topic META =".Dumper($meta));
|
|
# $this->{session}->writeDebug("AUTOATTACHING on $web.$topic\nFOUND BEFORE ".Dumper($ka)."\n");
|
|
|
|
# $this->{session}->writeDebug("KA2: ".Dumper(@knownAttachments));
|
|
my @attachmentsFoundInPub =
|
|
_findAttachments($this, $web, $topic, $ka);
|
|
# $this->{session}->writeDebug("FOUND AFTER ".Dumper(\@attachmentsFoundInPub));
|
|
|
|
if ($#attachmentsFoundInPub) {
|
|
$meta->putAll('FILEATTACHMENT', @attachmentsFoundInPub);
|
|
};
|
|
} else {
|
|
# $this->{session}->writeDebug("NOT AUTOATTACHING on $web.$topic\n ".Dumper($meta)."\n");
|
|
}
|
|
return $meta;
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod getTopicParent ( $web, $topic ) -> $string
|
|
|
|
Get the name of the topic parent. Needs to be fast because
|
|
of use by Render.pm.
|
|
|
|
=cut
|
|
|
|
# SMELL: does not honour access controls
|
|
|
|
sub getTopicParent {
|
|
my( $this, $web, $topic ) = @_;
|
|
ASSERT($this->isa('TWiki::Store')) if DEBUG;
|
|
ASSERT(defined($web)) if DEBUG;
|
|
ASSERT(defined($topic)) if DEBUG;
|
|
|
|
return undef unless $this->topicExists( $web, $topic );
|
|
|
|
my $handler = $this->_getHandler( $web, $topic );
|
|
|
|
my $strm = $handler->getStream();
|
|
my $data = '';
|
|
while( ( my $line = <$strm> ) ) {
|
|
if( $line !~ /^%META:/ ) {
|
|
last;
|
|
} else {
|
|
$data .= $line;
|
|
}
|
|
}
|
|
close( $strm );
|
|
|
|
my $meta = new TWiki::Meta( $this->{session}, $web, $topic );
|
|
$this->extractMetaData( $meta, \$data );
|
|
my $parentMeta = $meta->get( 'TOPICPARENT' );
|
|
return $parentMeta->{name} if $parentMeta;
|
|
return undef;
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod getTopicLatestRevTime ( $web, $topic ) -> $epochSecs
|
|
|
|
Get an approximate rev time for the latest rev of the topic. This method
|
|
is used to optimise searching. Needs to be as fast as possible.
|
|
|
|
=cut
|
|
|
|
sub getTopicLatestRevTime {
|
|
my ( $this, $web, $topic ) = @_;
|
|
$web =~ s#\.#/#go;
|
|
|
|
my $handler = $this->_getHandler( $web, $topic );
|
|
return $handler->getLatestRevisionTime();
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod readMetaData( $web, $name ) -> $text
|
|
|
|
Read a named meta-data string. If web is given the meta-data
|
|
is stored alongside a web.
|
|
|
|
=cut
|
|
|
|
sub readMetaData {
|
|
my ( $this, $web, $name ) = @_;
|
|
ASSERT($this->isa('TWiki::Store')) if DEBUG;
|
|
$web =~ s#\.#/#go;
|
|
|
|
my $handler = $this->_getHandler( $web );
|
|
return $handler->readMetaData( $name );
|
|
}
|
|
|
|
# Add TOPICINFO type data to the object, as specified by the parameters.
|
|
# * =$rev= - the revision number
|
|
# * =$time= - the time stamp
|
|
# * =$user= - the user object
|
|
# SMELL: Duplicate rev control info in the topic
|
|
sub addTOPICINFO {
|
|
my( $meta, $rev, $time, $user, $repRev ) = @_;
|
|
$rev = 1 if $rev < 1;
|
|
|
|
my %options =
|
|
(
|
|
# compatibility; older versions of the code use
|
|
# RCS rev numbers save with them so old code can
|
|
# read these topics
|
|
version => '1.'.$rev,
|
|
date => $time,
|
|
author => $user->wikiName(),
|
|
format => $TWiki::Store::STORE_FORMAT_VERSION,
|
|
);
|
|
# if this is a reprev, then store the revision that was affected.
|
|
# Required so we can tell when a merge is based on something that
|
|
# is *not* the original rev where another users' edit started.
|
|
# See Bugs:Item1897.
|
|
$options{reprev} = '1.'.$rev if $repRev;
|
|
|
|
$meta->put( 'TOPICINFO', \%options );
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod saveMetaData( $web, $name ) -> $text
|
|
|
|
Write a named meta-data string. If web is given the meta-data
|
|
is stored alongside a web.
|
|
|
|
=cut
|
|
|
|
sub saveMetaData {
|
|
my ( $this, $web, $name, $text ) = @_;
|
|
ASSERT($this->isa('TWiki::Store')) if DEBUG;
|
|
$web =~ s#\.#/#go;
|
|
|
|
my $handler = $this->_getHandler( $web );
|
|
return $handler->saveMetaData( $name, $text );
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod getTopicNames( $web ) -> @topics
|
|
|
|
Get list of all topics in a web
|
|
* =$web= - Web name, required, e.g. ='Sandbox'=
|
|
Return a topic list, e.g. =( 'WebChanges', 'WebHome', 'WebIndex', 'WebNotify' )=
|
|
|
|
=cut
|
|
|
|
sub getTopicNames {
|
|
my( $this, $web ) = @_ ;
|
|
ASSERT($this->isa('TWiki::Store')) if DEBUG;
|
|
|
|
$web =~ s#\.#/#go;
|
|
|
|
my $handler = $this->_getHandler( $web );
|
|
return $handler->getTopicNames();
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod getListOfWebs( $filter ) -> @webNames
|
|
|
|
Gets a list of webs, filtered according to the spec in the $filter,
|
|
which may include one of:
|
|
1 'user' (for only user webs)
|
|
2 'template' (for only template webs)
|
|
$filter may also contain the word 'public' which will further filter
|
|
webs on whether NOSEARCHALL is specified for them or not.
|
|
'allowed' filters out webs that the user is denied access to by a *WEBVIEW.
|
|
|
|
If $TWiki::cfg{EnableHierarchicalWebs} is set, will also list
|
|
sub-webs recursively.
|
|
|
|
=cut
|
|
|
|
sub getListOfWebs {
|
|
my( $this, $filter, $web ) = @_;
|
|
ASSERT($this->isa('TWiki::Store')) if DEBUG;
|
|
$filter ||= '';
|
|
$web ||= '';
|
|
$web =~ s#\.#/#g;
|
|
|
|
my @webList = $this->_getSubWebs( $web );
|
|
|
|
if ( $filter =~ /\buser\b/ ) {
|
|
@webList = grep { !/(?:^_|\/_)/, } @webList;
|
|
} elsif( $filter =~ /\btemplate\b/ ) {
|
|
@webList = grep { /(?:^_|\/_)/, } @webList;
|
|
}
|
|
|
|
my $user = $this->{session}->{user};
|
|
if( $filter =~ /\bpublic\b/ && !$user->isAdmin()) {
|
|
my $prefs = $this->{session}->{prefs};
|
|
my $wn = $this->{session}->{webName};
|
|
@webList =
|
|
grep {
|
|
$_ eq $wn ||
|
|
!$prefs->getWebPreferencesValue( 'NOSEARCHALL', $_ )
|
|
} @webList;
|
|
}
|
|
|
|
if( $filter =~ /\ballowed\b/ ) {
|
|
my $security = $this->{session}->{security};
|
|
@webList =
|
|
grep {
|
|
$security->checkAccessPermission(
|
|
'view', $user, undef, undef, undef, $_ )
|
|
} @webList;
|
|
}
|
|
|
|
return sort @webList;
|
|
}
|
|
|
|
# get a list of directories within the named web directory. If hierarchical
|
|
# webs are enabled, returns a deep list e.g. web, web/subweb,
|
|
# web/subweb/subsubweb
|
|
sub _getSubWebs {
|
|
my( $this, $web ) = @_ ;
|
|
|
|
my $handler = $this->_getHandler( $web );
|
|
my @tmpList = $handler->getWebNames();
|
|
# filter only those webs that meet the webExists criteria
|
|
my @webList;
|
|
if( $web ) {
|
|
# sub-web
|
|
@webList = sort
|
|
grep { $this->webExists( $_ ) } # filter dirs with no WebHome
|
|
map { $web.'/'.$_ } # add hierarchical path
|
|
@tmpList;
|
|
} else {
|
|
# root level (no parent web)
|
|
@webList = sort
|
|
grep { $this->webExists( $_ ) } # filter dirs with no WebHome
|
|
@tmpList;
|
|
}
|
|
|
|
if( $TWiki::cfg{EnableHierarchicalWebs} ) {
|
|
my @subWebList = ();
|
|
foreach my $subWeb ( @webList ) {
|
|
push( @subWebList, $this->_getSubWebs( $subWeb ));
|
|
}
|
|
push( @webList, @subWebList );
|
|
}
|
|
|
|
return @webList;
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod createWeb( $user, $newWeb, $baseWeb, $opts )
|
|
|
|
$newWeb is the name of the new web.
|
|
|
|
$baseWeb is the name of an existing web (a template web). If the
|
|
base web is a system web, all topics in it
|
|
will be copied into the new web. If it is a normal web, only topics starting
|
|
with 'Web' will be copied. If no base web is specified, an empty web
|
|
(with no topics) will be created. If it is specified but does not exist,
|
|
an error will be thrown.
|
|
|
|
$opts is a ref to a hash that contains settings to be modified in
|
|
the web preferences topic in the new web.
|
|
|
|
=cut
|
|
|
|
sub createWeb {
|
|
my ( $this, $user, $newWeb, $baseWeb, $opts ) = @_;
|
|
ASSERT($this->isa('TWiki::Store')) if DEBUG;
|
|
ASSERT($user->isa('TWiki::User')) if DEBUG;
|
|
|
|
unless( $baseWeb ) {
|
|
# For a web to be a web, it has to have at least one topic
|
|
my $meta = new TWiki::Meta( $this->{session}, $newWeb,
|
|
$TWiki::cfg{WebPrefsTopicName} );
|
|
$this->saveTopic( $user, $newWeb, $TWiki::cfg{WebPrefsTopicName},
|
|
"Preferences", $meta );
|
|
return;
|
|
}
|
|
|
|
unless( $this->webExists( $baseWeb )) {
|
|
throw Error::Simple( 'Base web '.$baseWeb.' does not exist' );
|
|
}
|
|
|
|
$newWeb =~ s#\.#/#go;
|
|
$baseWeb =~ s#\.#/#go if $baseWeb;
|
|
# copy topics from base web
|
|
my @topicList = $this->getTopicNames( $baseWeb );
|
|
|
|
unless( $baseWeb =~ /^_/ ) {
|
|
# not a system web, so filter for only Web* topics
|
|
@topicList = grep { /^Web/ } @topicList;
|
|
}
|
|
|
|
foreach my $topic ( @topicList ) {
|
|
$this->copyTopic( $user, $baseWeb, $topic, $newWeb, $topic );
|
|
}
|
|
|
|
# create meta-data files
|
|
$this->saveMetaData( $newWeb, 'changes', '');
|
|
$this->saveMetaData( $newWeb, 'mailnotify', '');
|
|
|
|
# patch WebPreferences in new web
|
|
my $wpt = $TWiki::cfg{WebPrefsTopicName};
|
|
|
|
return unless $this->topicExists( $newWeb, $wpt );
|
|
|
|
my( $meta, $text ) =
|
|
$this->readTopic( undef, $newWeb, $wpt, undef );
|
|
|
|
if( $opts ) {
|
|
foreach my $key ( %$opts ) {
|
|
$text =~ s/($TWiki::regex{setRegex}$key\s*=).*?$/$1 $opts->{$key}/gm;
|
|
}
|
|
}
|
|
$this->saveTopic( $user, $newWeb, $wpt, $text, $meta );
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod removeWeb( $user, $web )
|
|
|
|
* =$user= - user doing the removing (for the history)
|
|
* =$web= - web being removed
|
|
|
|
Destroy a web, utterly. Removed the data and attachments in the web.
|
|
|
|
Use with great care!
|
|
|
|
The web must be a known web to be removed this way.
|
|
|
|
=cut
|
|
|
|
sub removeWeb {
|
|
my( $this, $user, $web ) = @_;
|
|
ASSERT( $web ) if DEBUG;
|
|
$web =~ s#\.#/#go;
|
|
|
|
unless( $this->webExists( $web )) {
|
|
throw Error::Simple( 'No such web '.$web );
|
|
}
|
|
|
|
my $handler = $this->_getHandler( $web );
|
|
$handler->removeWeb();
|
|
}
|
|
|
|
# STATIC Write a meta-data key=value pair
|
|
# The encoding is reversed in _readKeyValues
|
|
# SMELL: this uses a really bad escape encoding
|
|
# 1. it doesn't handle all characters that need escaping.
|
|
# 2. it's excessively noisy
|
|
# 3. it's not a reversible encoding; \r's are lost
|
|
sub _writeKeyValue {
|
|
my( $key, $value ) = @_;
|
|
|
|
if( defined( $value )) {
|
|
$value = dataEncode( $value );
|
|
} else {
|
|
$value = '';
|
|
}
|
|
|
|
return $key.'="'.$value.'"';
|
|
}
|
|
|
|
# Write all the key=value pairs for the types listed
|
|
sub _writeTypes {
|
|
my( $meta, @types ) = @_;
|
|
ASSERT($meta->isa('TWiki::Meta')) if DEBUG;
|
|
|
|
my $text = '';
|
|
|
|
if( $types[0] eq 'not' ) {
|
|
# write all types that are not in the list
|
|
my %seen;
|
|
@seen{ @types } = ();
|
|
@types = (); # empty "not in list"
|
|
foreach my $key ( keys %$meta ) {
|
|
push( @types, $key ) unless
|
|
(exists $seen{ $key } || $key =~ /^_/);
|
|
}
|
|
}
|
|
|
|
foreach my $type ( @types ) {
|
|
my $data = $meta->{$type};
|
|
foreach my $item ( @$data ) {
|
|
my $sep = '';
|
|
$text .= '%META:'.$type.'{';
|
|
my $name = $item->{name};
|
|
if( $name ) {
|
|
# If there's a name field, put first to make regexp based searching easier
|
|
$text .= _writeKeyValue( 'name', $item->{name} );
|
|
$sep = ' ';
|
|
}
|
|
foreach my $key ( sort keys %$item ) {
|
|
if( $key ne 'name' ) {
|
|
$text .= $sep;
|
|
$text .= _writeKeyValue( $key, $item->{$key} );
|
|
$sep = ' ';
|
|
}
|
|
}
|
|
$text .= '}%'."\n";
|
|
}
|
|
}
|
|
|
|
return $text;
|
|
}
|
|
|
|
# STATIC Meta data for start of topic
|
|
sub _writeStart {
|
|
my( $meta ) = @_;
|
|
|
|
return _writeTypes( $meta, qw/TOPICINFO TOPICPARENT/ );
|
|
}
|
|
|
|
# STATIC Meta data for end of topic
|
|
sub _writeEnd {
|
|
my( $meta ) = @_;
|
|
|
|
my $text = _writeTypes($meta, qw/FORM FIELD FILEATTACHMENT TOPICMOVED/ );
|
|
# append remaining meta data
|
|
$text .= _writeTypes( $meta, qw/not TOPICINFO TOPICPARENT FORM FIELD FILEATTACHMENT TOPICMOVED/ );
|
|
return $text;
|
|
}
|
|
|
|
# STATIC Prepend/append meta data to topic
|
|
sub _writeMeta {
|
|
my( $meta, $text ) = @_;
|
|
ASSERT($meta->isa('TWiki::Meta')) if DEBUG;
|
|
$text ||= '';
|
|
|
|
my $start = _writeStart( $meta );
|
|
my $end = _writeEnd( $meta );
|
|
$text = $start . $text;
|
|
$end = "\n".$end if $end;
|
|
$text .= $end;
|
|
|
|
return $text;
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod getDebugText($meta, $text) -> $text
|
|
|
|
Generate a debug text form of the text/meta, for use in debug displays,
|
|
by annotating the text with meta informtion.
|
|
|
|
=cut
|
|
|
|
sub getDebugText {
|
|
my ( $this, $meta, $text ) = @_;
|
|
ASSERT($this->isa('TWiki::Store')) if DEBUG;
|
|
|
|
return _writeMeta( $meta, $text );
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod cleanUpRevID( $rev ) -> $integer
|
|
|
|
Cleans up (maps) a user-supplied revision ID and converts it to an integer
|
|
number that can be incremented to create a new revision number.
|
|
|
|
This method should be used to sanitise user-provided revision IDs.
|
|
|
|
=cut
|
|
|
|
sub cleanUpRevID {
|
|
my ( $this, $rev ) = @_;
|
|
ASSERT($this->isa('TWiki::Store')) if DEBUG;
|
|
|
|
return 0 unless $rev;
|
|
|
|
$rev =~ s/^r(ev)?//i;
|
|
$rev =~ s/^\d+\.//; # clean up RCS rev number
|
|
$rev =~ s/[^\d]//g; # digits only
|
|
|
|
return TWiki::Sandbox::untaintUnchecked( $rev );
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod copyTopic($user, $fromweb, $fromtopic, $toweb, $totopic)
|
|
|
|
Copy a topic and all it's attendant data from one web to another.
|
|
|
|
SMELL: Does not fix up meta-data!
|
|
|
|
=cut
|
|
|
|
sub copyTopic {
|
|
my ( $this, $user, $fromWeb, $fromTopic, $toWeb, $toTopic ) = @_;
|
|
ASSERT($this->isa('TWiki::Store')) if DEBUG;
|
|
$fromWeb =~ s#\.#/#go;
|
|
$toWeb =~ s#\.#/#go;
|
|
|
|
my $handler = $this->_getHandler( $fromWeb, $fromTopic );
|
|
$handler->copyTopic( $toWeb, $toTopic );
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod searchMetaData($params) -> $text
|
|
|
|
Search meta-data associated with topics. Parameters are passed in the $params hash,
|
|
which may contain:
|
|
| =type= | =topicmoved=, =parent= or =field= |
|
|
| =topic= | topic to search for, for =topicmoved= and =parent= |
|
|
| =name= | form field to search, for =field= type searches. May be a regex. |
|
|
| =value= | form field value. May be a regex. |
|
|
| =title= | Title prepended to the returned search results |
|
|
| =default= | defualt value if there are no results |
|
|
| =web= | web to search in, default is all webs |
|
|
The idea is that people can search for meta-data values without having to be
|
|
aware of how or where meta-data is stored.
|
|
|
|
SMELL: should be replaced with a proper SQL-like search, c.f. Plugins.DBCacheContrib.
|
|
|
|
=cut
|
|
|
|
sub searchMetaData {
|
|
my ( $this, $params ) = @_;
|
|
|
|
my $attrType = $params->{type} || 'FIELD';
|
|
my $attrWeb = $params->{web} || $this->{session}->{webName};
|
|
my $attrTopic = $params->{topic} || $this->{session}->{topicName};
|
|
|
|
my $searchVal = 'XXX';
|
|
|
|
if ( $attrType eq 'parent' ) {
|
|
$searchVal = "%META:TOPICPARENT[{].*name=\\\"($attrWeb\\.)?$attrTopic\\\".*[}]%";
|
|
} elsif ( $attrType eq 'topicmoved' ) {
|
|
$searchVal = "%META:TOPICMOVED[{].*from=\\\"$attrWeb\.$attrTopic\\\".*[}]%";
|
|
} else {
|
|
$searchVal = "%META:".uc( $attrType )."[{].*";
|
|
$searchVal .= "name=\\\"$params->{name}\\\".*"
|
|
if (defined $params->{name});
|
|
$searchVal .= "value=\\\"$params->{value}\\\".*"
|
|
if (defined $params->{value});
|
|
$searchVal .= "[}]%";
|
|
}
|
|
|
|
my $text = '';
|
|
if ($params->{format}) {
|
|
$text = $this->{session}->{search}->searchWeb
|
|
(
|
|
format => $params->{format},
|
|
search => $searchVal,
|
|
web => $attrWeb,
|
|
type => 'regex',
|
|
nosummary => 'on',
|
|
nosearch => 'on',
|
|
noheader => 'on',
|
|
nototal => 'on',
|
|
noempty => 'on',
|
|
template => 'searchmeta',
|
|
inline => 1,
|
|
);
|
|
} else {
|
|
$this->{session}->{search}->searchWeb
|
|
(
|
|
_callback => \&_collate,
|
|
_cbdata => \$text,,
|
|
search => $searchVal,
|
|
web => $attrWeb,
|
|
type => 'regex',
|
|
nosummary => 'on',
|
|
nosearch => 'on',
|
|
noheader => 'on',
|
|
nototal => 'on',
|
|
noempty => 'on',
|
|
template => 'searchmeta',
|
|
inline => 1,
|
|
);
|
|
}
|
|
my $attrTitle = $params->{title} || '';
|
|
if( $text ) {
|
|
$text = $attrTitle.$text;
|
|
} else {
|
|
my $attrDefault = $params->{default} || '';
|
|
$text = $attrTitle.$attrDefault;
|
|
}
|
|
|
|
return $text;
|
|
}
|
|
|
|
# callback for search function to collate
|
|
# results
|
|
sub _collate {
|
|
my $ref = shift;
|
|
|
|
$$ref .= join( ' ', @_ );
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod searchInWebContent($searchString, $web, \@topics, \%options ) -> \%map
|
|
|
|
Search for a string in the content of a web. The search must be over all
|
|
content and all formatted meta-data, though the latter search type is
|
|
deprecated (use searchMetaData instead).
|
|
|
|
* =$searchString= - the search string, in egrep format if regex
|
|
* =$web= - The web to search in
|
|
* =\@topics= - reference to a list of topics to search
|
|
* =\%options= - reference to an options hash
|
|
The =\%options= hash may contain the following options:
|
|
* =type= - if =regex= will perform a egrep-syntax RE search (default '')
|
|
* =casesensitive= - false to ignore case (defaulkt true)
|
|
* =files_without_match= - true to return files only (default false)
|
|
|
|
The return value is a reference to a hash which maps each matching topic
|
|
name to a list of the lines in that topic that matched the search,
|
|
as would be returned by 'grep'. If =files_without_match= is specified, it will
|
|
return on the first match in each topic (i.e. it will return only one
|
|
match per topic, and will not return matching lines).
|
|
|
|
=cut
|
|
|
|
sub searchInWebContent {
|
|
my( $this, $searchString, $web, $topics, $options ) = @_;
|
|
$web =~ s#\.#/#go;
|
|
|
|
my $handler = $this->_getHandler( $web );
|
|
return $handler->searchInWebContent( $searchString, $topics, $options );
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod getRevisionAtTime( $web, $topic, $time ) -> $rev
|
|
|
|
* =$web= - web for topic
|
|
* =$topic= - topic
|
|
* =$time= - time (in epoch secs) for the rev
|
|
|
|
Get the revision number of a topic at a specific time.
|
|
Returns a single-digit rev number or undef if it couldn't be determined
|
|
(either because the topic isn't that old, or there was a problem)
|
|
|
|
=cut
|
|
|
|
sub getRevisionAtTime {
|
|
my ( $this, $web, $topic, $time ) = @_;
|
|
|
|
my $handler = $this->_getHandler( $web, $topic );
|
|
return $handler->getRevisionAtTime( $time );
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod getLease( $web, $topic ) -> $lease
|
|
|
|
* =$web= - web for topic
|
|
* =$topic= - topic
|
|
|
|
If there is an lease on the topic, return the lease, otherwise undef.
|
|
A lease is a block of meta-information about a topic that can be
|
|
recovered (this is a hash containing =user=, =taken= and =expires=).
|
|
Leases are taken out when a topic is edited. Only one lease
|
|
can be active on a topic at a time. Leases are used to warn if
|
|
another user is already editing a topic.
|
|
|
|
=cut
|
|
|
|
sub getLease {
|
|
my( $this, $web, $topic ) = @_;
|
|
|
|
my $handler = $this->_getHandler( $web, $topic );
|
|
my $lease = $handler->getLease();
|
|
if( $lease ) {
|
|
my $user = $this->{session}->{users}->findUser( $lease->{user} );
|
|
ASSERT( $user->isa('TWiki::User')) if DEBUG;
|
|
$lease->{user} = $user;
|
|
}
|
|
return $lease;
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod setLease( $web, $topic, $user, $length )
|
|
|
|
Take out an lease on the given topic for this user for $length seconds.
|
|
|
|
See =getLease= for more details about Leases.
|
|
|
|
=cut
|
|
|
|
sub setLease {
|
|
my( $this, $web, $topic, $user, $length ) = @_;
|
|
ASSERT( $user->isa( 'TWiki::User') ) if DEBUG;
|
|
|
|
my $handler = $this->_getHandler( $web, $topic );
|
|
my $lease;
|
|
if( $user ) {
|
|
my $t = time();
|
|
$lease = { user => $user->wikiName(),
|
|
expires => $t + $length,
|
|
taken => $t };
|
|
}
|
|
|
|
$handler->setLease( $lease );
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod clearLease( $web, $topic )
|
|
|
|
Cancel the current lease.
|
|
|
|
See =getLease= for more details about Leases.
|
|
|
|
=cut
|
|
|
|
sub clearLease {
|
|
my( $this, $web, $topic ) = @_;
|
|
|
|
my $handler = $this->_getHandler( $web, $topic );
|
|
$handler->setLease( undef );
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod removeSpuriousLeases( $web )
|
|
|
|
Remove leases that are not related to a topic. These can get left behind in
|
|
some store implementations when a topic is created, but never saved.
|
|
|
|
=cut
|
|
|
|
sub removeSpuriousLeases {
|
|
my( $this, $web ) = @_;
|
|
my $handler = $this->_getHandler( $web );
|
|
$handler->removeSpuriousLeases();
|
|
}
|
|
|
|
1;
|
|
|