*Show All results*: "
. _printTagLink( $qTag, $qBy, $thisWeb )
. "
\n"
if ( $c < $resultCount{$thisWeb} );
$footer =~ s/\$showmore/$morelink/g;
$footer =~ s/\$count/$resultCount{$thisWeb}/g;
$webText{$thisWeb} .= "\n$footer\n";
}
$text .= $webText{$thisWeb} . "\n";
}
}
}
else {
foreach $webTopic (@topics) {
$text .=
_printWebTopic( $webTopic, $topicTags{$webTopic}, $qBy,
$format, $tagVotes{$webTopic} );
$text .= $separator;
}
}
}
$text =~ s/\Q$separator\E$//s;
$text .= "\n%MAKETEXT{\"Number of topics\"}%: " . scalar( keys(%tagVotes) )
unless ($noTotal);
_handleMakeText($text);
return $text;
}
# =========================
sub _printWebTopic {
my ( $webTopic, $tagsRef, $qBy, $format, $voteCount, $size ) = @_;
$webTopic =~ /^(.*)\.(.)(.*)$/;
my $qWeb = $1;
my $qT1 = $2
; # Workaround for core bug Bugs:Item2625, fixed in SVN 11484, hotfix-4.0.4-4
my $qTopic = quotemeta("$2$3");
my $text = '%SEARCH{ '
. "\"^$qTopic\$\" scope=\"topic\" web=\"$qWeb\" topic=\"$qT1\*\" "
. 'regex="on" limit="1" nosearch="on" nototal="on" '
. "format=\"$format\"" . ' }%';
$text = TWiki::Func::expandCommonVariables( $text, $qTopic, $qWeb );
# TODO: should be conditional sort
$text =~
s/\$taglist/join( ', ', map{ _printTagLink( $_, $qBy ) } sort { lc $a cmp lc $b} @{$tagsRef} )/geo;
$text =~ s/\$size/$size/go if ($size);
$text =~ s/\$votecount/$voteCount/go;
return $text;
}
# =========================
sub _printTagLink {
my ( $qTag, $by, $web, $refine ) = @_;
$web = '' unless ( defined($web) );
my $links = '';
foreach my $tag ( split( /,\s*/, $qTag ) ) {
my $text = $tagLinkFormat;
if ($refine) {
$text = '' . $tag . '';
}
# urlencode characters
# in 2 passes
my $tmpSep = '_#_';
$text =~ s/(tag=)\$tag/$1$tmpSep\$tag$tmpSep/go;
$text =~ s/$tmpSep\$tag$tmpSep/&_urlEncode($tag)/geo;
$text =~ s/\$tag/$tag/go;
$text =~ s/\$by/$by/go;
$text =~ s/\$web/$web/go;
$links .= $text;
}
return $links;
}
# =========================
# Add new tag to system
sub _newTag {
my ($attr) = @_;
my $tag = defined($attr->{tag}) ? $attr->{tag} : '';
my $note = defined($attr->{note}) ? $attr->{note} : '';
my $silent = defined($attr->{silent}) ? $attr->{silent} : '';
my $query = TWiki::Func::getCgiQuery();
my $postChangeRequest = $query->param('postChangeRequest') || '';
if ($postChangeRequest) {
return _handlePostChangeRequest( 'create', undef, $tag, $note );
}
if ( !_canChange() || $user =~ /^(TWikiGuest|guest)$/ ) {
return _htmlErrorFeedbackChangeMessage( 'create', $note );
}
$tag = _makeSafeTag($tag);
return _wrapHtmlErrorFeedbackMessage( "Please enter a tag", $note )
unless ($tag);
my @allTags = _readAllTags();
if ( grep( /^\Q$tag\E$/, @allTags ) ) {
return _wrapHtmlErrorFeedbackMessage("Tag \"$tag\" already exists", $note ) unless (defined $silent) ;
}
else {
push( @allTags, $tag );
writeAllTags(\@allTags);
_writeLog("New tag '$tag'");
my $query = TWiki::Func::getCgiQuery();
my $from = $query->param('from');
if ($from) {
$note = ''
. 'Add tag "%URLPARAM{newtag}%" to %URLPARAM{"from"}%%BR%'
. $note;
}
return _wrapHtmlFeedbackMessage( "Tag \"$tag\" is successfully added",
$note );
}
return "";
}
# =========================
# Normalize tag, strip illegal characters, limit length
sub _makeSafeTag {
my ($tag) = @_;
if ($normalizeTagInput) {
$tag =~ s/[- \/]/_/go;
$tag = lc($tag);
$tag =~ s/[^${alphaNum}_]//go;
$tag =~ s/_+/_/go; # replace double underscores with single
}
else {
$tag =~ s/[\x01-\x1f^\#\,\'\"\|\*]//go; # strip #,'"|*
}
$tag = substr($tag, 0, $maxTagLen) if ( length($tag) > $maxTagLen ); # limit tag length
$tag =~ s/^\s*//; # trim spaces at start
$tag =~ s/\s*$//; # trim spaces at end
return $tag;
}
# =========================
# Add tag to topic
# The tag must already exist
sub _addTag {
my ( $attr ) = @_;
my $addTag = defined($attr->{tag}) ? $attr->{tag} : '';
my $noStatus = defined($attr->{nostatus}) ? $attr->{nostatus} : '';
my $webTopic = "$web.$topic";
my @tagInfo = _readTagInfo($webTopic);
my $text = '';
my $tag = '';
my $num = '';
my $users = '';
my @result = ();
my $tagExists = scalar( grep{ /^\Q$addTag\E$/ } _readAllTags() );
if ( !$tagExists ) {
$text .= _wrapHtmlFeedbackErrorInline("tag not added, it needs to be created first");
} elsif ( TWiki::Func::topicExists( $web, $topic ) ) {
if ( _canTag() ) {
foreach my $line (@tagInfo) {
if ( $line =~ /$lineRegex/o ) {
$num = $1;
$tag = $2;
$users = $3;
if ( $tag eq $addTag ) {
if ( $users =~ /\b$user\b/ ) {
$text .=
_wrapHtmlFeedbackErrorInline(
"you already added this tag");
}
else {
# add user to existing tag
$line =
_tagDataLine( $num + 1, $tag, $users, $user );
$text .= _wrapHtmlFeedbackInline(
"added tag vote on \"$tag\"");
_writeLog("Added tag vote on '$tag'");
}
}
}
push( @result, $line );
}
unless ($text) {
# tag does not exist yet
if ($addTag) {
push( @result, "001, $addTag, $user" );
$text .= _wrapHtmlFeedbackInline("added tag \"$addTag\"");
_writeLog("Added tag '$addTag'");
}
else {
$text .= _wrapHtmlFeedbackInline(" (please select a tag)");
}
}
@tagInfo = reverse sort(@result);
_writeTagInfo( $webTopic, @tagInfo );
}
else {
$text .= "You are not allowed to add tags to this topic";
}
} else {
$text .= _wrapHtmlFeedbackErrorInline("tag not added, topic does not exist");
}
# Suppress status? FWM, 03-Oct-2006
return _showDefault(tagInfo => \@tagInfo,
status => ($noStatus ? '' : $text) );
}
# =========================
# Create and tag with multiple tags
sub _newTagsAndAdd {
my ( $attr ) = @_;
my $text;
my $args;
my $tags = defined($attr->{tag}) ? $attr->{tag} : '';
my $noStatus = defined($attr->{nostatus}) ? $attr->{nostatus} : '';
$tags =~ s/^\s+//o;
$tags =~ s/\s+$//o;
$tags =~ s/\s\s+/ /go;
foreach my $tag ( split( ' ', $tags )) {
$tag = _makeSafeTag($tag);
if ($tag) {
$args = { tag => $tag };
$text = _newTag($args);
unless ( $text =~ /twikiAlert/ ) {
$args->{nostatus} = 'on' if ( $noStatus );
$text = _addTag($args);
}
}
}
return $text;
}
# =========================
# Remove my tag vote from topic
sub _removeTag {
my ( $attr ) = @_;
my $removeTag = defined($attr->{tag}) ? $attr->{tag} : '';
my $noStatus = defined($attr->{nostatus}) ? $attr->{nostatus} : '';
my $webTopic = "$web.$topic";
my @tagInfo = _readTagInfo($webTopic);
my $text = '';
my $tag = '';
my $num = '';
my $users = '';
my $found = 0;
my @result = ();
if ( _canTag() ) {
foreach my $line (@tagInfo) {
if ( $line =~ /$lineRegex/o ) {
$num = $1;
$tag = $2;
$users = $3;
if ( $tag eq $removeTag ) {
my %userHash = map { $_ => 1 } split(/, */, $users);
if ( $userHash{$user} ) {
$found = 1;
delete $userHash{$user};
$users = join(', ', sort keys %userHash);
$num--;
if ($num) {
$line = _tagDataLine( $num, $tag, $users );
$text .=
_wrapHtmlFeedbackInline(
"removed my tag vote on \"$tag\"");
_writeLog("Removed tag vote on '$tag'");
push( @result, $line );
}
else {
$text .=
_wrapHtmlFeedbackInline("removed tag \"$tag\"");
_writeLog("Removed tag '$tag'");
}
}
}
else {
push( @result, $line );
}
}
else {
push( @result, $line );
}
}
if ($found) {
@tagInfo = reverse sort(@result);
_writeTagInfo( $webTopic, @tagInfo );
}
else {
$text .=
_wrapHtmlFeedbackErrorInline("Tag \"$removeTag\" not found");
}
}
else {
$text = _wrapHtmlFeedbackErrorInline(
"You are not allowed to remove tags from this topic");
}
# Suppress status? FWM, 03-Oct-2006
return _showDefault(tagInfo => \@tagInfo,
status => ($noStatus ? '' : $text));
}
# =========================
# Force remove tag from topic (clear all users votes)
sub _removeAllTag {
my ( $attr ) = @_;
my $removeTag = defined($attr->{tag}) ? $attr->{tag} : '';
my $noStatus = defined($attr->{nostatus}) ? $attr->{nostatus} : '';
my $webTopic = "$web.$topic";
my @tagInfo = _readTagInfo($webTopic);
my $text = '';
my $tag = '';
my $num = '';
my $found = 0;
my @result = ();
if ( _canTag() ) {
foreach my $line (@tagInfo) {
if ( $line =~ /$lineRegex/o ) {
$num = $1;
$tag = $2;
if ( $tag eq $removeTag ) {
$text .= _wrapHtmlFeedbackInline("removed tag \"$tag\"");
_writeLog("Removed tag '$tag'");
$found = 1;
} else {
push( @result, $line );
}
} else {
push( @result, $line );
}
}
if ($found) {
@tagInfo = reverse sort(@result);
_writeTagInfo( $webTopic, @tagInfo );
} else {
$text .=
_wrapHtmlFeedbackErrorInline("Tag \"$removeTag\" not found");
}
}
else {
$text = _wrapHtmlFeedbackErrorInline(
"You are not allowed to remove tags from this topic");
}
# Suppress status? FWM, 03-Oct-2006
return _showDefault(tagInfo => \@tagInfo,
status => ($noStatus ? '' : $text));
}
# =========================
sub _tagDataLine {
my ( $num, $tag, $users, $user ) = @_;
my $line = sprintf( '%03d', $num );
$line .= ", $tag, $users";
$line .= ", $user" if $user;
return $line;
}
# =========================
sub _imgTag {
my ( $image, $title, $action, $tag, $tagMode ) = @_;
my $text = '';
#my $tagMode |= '';
if ($tag) {
$text =
"";
}
$text .=
"![\"$title\"](\"$attachUrl/$image.gif\"" "\\"$title\\"\"")
";
$text .= "" if ($tag);
return $text;
}
# =========================
sub _workAreaDir {
if ( $TWiki::cfg{TagMePlugin}{SplitSpace} ) {
my ($w, $withTopic) = @_;
$w =~ s:/:.:g;
$w =~ s/\.[^.]+$// if ( $withTopic );
$w = _manipWeb($w);
return TWiki::Func::getPubDir($w) . "/$w/.tags";
}
else {
return $workAreaDir;
}
}
# =========================
use Sys::Hostname;
sub mkdirRecursive {
my $dir = shift;
my $parent = $dir;
$parent =~ s:/[^/]+$::;
if ( ! -d $parent && $dir ne $parent ) {
mkdirRecursive($parent) or
return 0;
}
return mkdir($dir);
}
sub _saveFile {
my ($file, $text) = @_;
_writeDebug("_saveFile($file, ...)");
my $dir = $file;
if ( $dir =~ s:/[^/]+$:: ) {
unless ( -d $dir ) {
mkdirRecursive($dir) or do {
_writeWarning("mkdir: $dir: $!");
return 0;
};
}
}
my $tmpFile = "$file.$$." . hostname() . '.tmp';
open(FILE, ">$tmpFile") or do {
_writeWarning("open: >$tmpFile: $!");
return 0;
};
print FILE $text or do {
_writeWarning("print: >$tmpFile: $!");
return 0;
};
close(FILE) or do {
_writeWarning("close: >$tmpFile: $!");
return 0;
};
rename($tmpFile, $file) or do {
_writeWarning("rename: $tmpFile -> $file: $!");
return 0;
};
return 1
}
# =========================
sub _getTagInfoList {
my @list;
my $workDir = _workAreaDir($web);
if ( opendir( DIR, $workDir ) ) {
my @files = sort
grep { !/^\./ } # eliminate . and ..
readdir(DIR);
closedir DIR;
for ( @files ) {
if ( /^_tags_(.*)\.txt$/ ) {
next if ( $1 eq 'all' );
push(@list, $1);
}
}
}
return sort @list;
}
# =========================
sub _readTagInfo {
my ($webTopic) = @_;
$webTopic =~ s/[\/\\]/\./g;
my $workDir = _workAreaDir($webTopic, 1);
my $text = TWiki::Func::readFile("$workDir/_tags_$webTopic.txt");
my @info = grep { /^[0-9]/ } split( /\n/, $text );
if ( $userAgnostic ) {
for ( @info ) {
s/$lineRegex/001, $2, $user/o;
}
}
return @info;
}
# =========================
sub _writeTagInfo {
my ( $webTopic, @info ) = @_;
$webTopic =~ s/[\/\\]/\./g;
my $workDir = _workAreaDir($webTopic, 1);
my $file = "$workDir/_tags_$webTopic.txt";
if ( scalar @info ) {
my $text =
"# This file is generated, do not edit\n"
. join( "\n", reverse sort @info ) . "\n";
_saveFile( $file, $text );
}
elsif ( -e $file ) {
unlink($file);
}
}
# =========================
sub renameOrCopyTagInfo {
my ( $oldWebTopic, $newWebTopic, $opr ) = @_;
$oldWebTopic =~ s/[\/\\]/\./g;
$newWebTopic =~ s/[\/\\]/\./g;
my $workDirO = _workAreaDir($oldWebTopic, 1);
my $workDirN = _workAreaDir($newWebTopic, 1);
my $oldFile = "$workDirO/_tags_$oldWebTopic.txt";
my $newFile = "$workDirN/_tags_$newWebTopic.txt";
if ( -e $oldFile ) {
my $newTrash = $newWebTopic =~ /^Trash\./;
# the tag file is moved to Trash so that it can be undeleted.
if ( -d $workDirN || $newTrash ) {
my $text = TWiki::Func::readFile($oldFile);
if ( $workDirO ne $workDirN && !$newTrash ) {
# If there are missing tags in the tag list of the destination
# (_tags_all.txt), add them.
my @tagsOfTopic;
for ( split(/\n/, $text) ) {
if ( /$lineRegex/ ) {
push(@tagsOfTopic, $2);
}
}
my $newWeb = $newWebTopic;
$newWeb =~ s/\.[^.]+$//;
my %tagOfNewWeb = map { $_ => 1 } _readAllTags($newWeb);
my $nTags = keys %tagOfNewWeb;
@tagOfNewWeb{@tagsOfTopic} = (1) x @tagsOfTopic;
my @tagsOfNewWeb = keys %tagOfNewWeb;
if ( $nTags != @tagsOfNewWeb ) {
writeAllTags(\@tagsOfNewWeb, $newWeb);
}
}
_saveFile( $newFile, $text );
}
else {
_writeWarning(
"tags are not copied from $oldWebTopic to $newWebTopic because " .
"the destination web is not using tags"
);
}
unlink($oldFile) if ( $opr ne 'copy' );
}
}
# =========================
sub _readAllTags {
my ($w) = @_;
$w ||= $web;
my $workDir = _workAreaDir($w);
my $text = TWiki::Func::readFile("$workDir/_tags_all.txt");
#my @tags = grep{ /^[${alphaNum}_]/ } split( /\n/, $text );
# we assume that this file has been written by TagMe, so tags should be
# valid, and we only need to filter out the comment line
my @tags = grep { !/^\#.*/ } split( /\n/, $text );
return @tags;
}
# =========================
# Sorting of tags (lowercase comparison) is done just before writing of
# the _tags_all file.
sub writeAllTags {
my ($tagsRef, $w) = @_;
$w ||= $web;
my $text =
"# This file is generated, do not edit\n"
. join( "\n", sort { lc $a cmp lc $b } @$tagsRef ) . "\n";
my $workDir = _workAreaDir($w);
_saveFile( "$workDir/_tags_all.txt", $text );
}
# =========================
sub _modifyTag {
my ( $oldTag, $newTag, $changeMessage, $note ) = @_;
return _htmlErrorFeedbackChangeMessage( 'modify', $note ) if !_canChange();
my @allTags = _readAllTags();
if ($oldTag) {
if ( !grep( /^\Q$oldTag\E$/, @allTags ) ) {
return _wrapHtmlErrorFeedbackMessage(
"Tag \"$oldTag\" does not exist", $note );
}
}
if ($newTag) {
if ( grep( /^\Q$newTag\E$/, @allTags ) ) {
return _wrapHtmlErrorFeedbackMessage(
"Tag \"$newTag\" already exists", $note );
}
}
my @newAllTags = grep( !/^\Q$oldTag\E$/, @allTags );
push( @newAllTags, $newTag ) if ($newTag);
writeAllTags(\@newAllTags);
my $webTopic = '';
foreach $webTopic ( _getTagInfoList() ) {
next if ( $topicsRegex && $webTopic !~ /$topicsRegex/ );
my @tagInfo = _readTagInfo($webTopic);
my $tag = '';
my $num = '';
my $users = '';
my $tagChanged = 0; # only save new file if content should be updated
my @result = ();
foreach my $line (@tagInfo) {
if ( $line =~ /^($lineRegex)$/o ) {
$line = $1;
$num = $2;
$tag = $3;
$users = $4;
if ($newTag) {
# rename
if ( $tag eq $oldTag ) {
$line = _tagDataLine( $num, $newTag, $users );
$tagChanged = 1;
}
push( @result, $line );
}
else {
# delete
if ( $tag eq $oldTag ) {
$tagChanged = 1;
}
else {
push( @result, $line );
}
}
}
}
if ($tagChanged) {
@result = reverse sort(@result);
$webTopic =~ /(.*)/;
$webTopic = $1; # untaint
_writeTagInfo( $webTopic, @result );
}
}
_writeLog($changeMessage);
return _wrapHtmlFeedbackMessage( $changeMessage, $note );
}
# =========================
sub _canTag {
return $canTag if ( defined($canTag) );
return $canTag = 0 if ( $inactiveSite );
my $allowTopic = TWiki::Func::getPreferencesValue('ALLOWTOPICTAG') || '';
my $allowWeb = TWiki::Func::getPreferencesValue('ALLOWWEBTAG', $web) || '';
my $denyTopic = TWiki::Func::getPreferencesValue('DENYTOPICTAG') || '';
my $denyWeb = TWiki::Func::getPreferencesValue('DENYWEBTAG', $web) || '';
my $mode =
( $allowTopic =~ /\S/ || $allowWeb =~ /\S/ ||
$denyTopic =~ /\S/ || $denyWeb =~ /\S/ ) ? 'TAG' : 'CHANGE';
my $wikiUserName = TWiki::Func::getWikiName();
# You may think that under user conscious taggin, everybody is supposed to
# be able to tag every topic.
# But it's better for users owning a topic or a web to be able to restrict
# who can tag even under user conscious tagging.
return $canTag = 1
if ( TWiki::Func::checkAccessPermission( $mode, $wikiUserName, undef, $topic, $web, undef) );
return $canTag = _canChange();
# Everybody who can change tags needs to be able to tag and untag pages.
# This is because to delete a tag from the tag set, the tag needs to be
# removed from all topics
}
# =========================
sub _canChange {
return $canChange if ( defined($canChange) );
my $session = $TWiki::Plugins::SESSION;
return $canChange = 0 if ( $inactiveSite );
my $deny;
my $allow;
if ( $TWiki::cfg{TagMePlugin}{SplitSpace} ) {
$deny = TWiki::Func::getPreferencesValue('DENY_TAG_CHANGE', $web);
$allow = TWiki::Func::getPreferencesValue('ALLOW_TAG_CHANGE', $web);
}
else {
$deny = TWiki::Func::getPreferencesValue('DENY_TAG_CHANGE');
$allow = TWiki::Func::getPreferencesValue('ALLOW_TAG_CHANGE');
}
$deny ||= '';
$allow ||= '';
if ( $deny =~ /\S/ || $allow =~ /\S/ ) {
# If either or both of DENY_TAG_CHANGE and ALLOW_TAG_CHANGE are
# defined, then they are used to determine tag change permission.
# Even if they deny tag change, site admins and web admins have
# tag change permission.
my $wikiName = TWiki::Func::getWikiName();
if ( $deny =~ /\S/ ) {
if ( _isInList($deny) ) {
return $canChange = 0 unless ( TWiki::Func->can('isAnAdmin') );
return $canChange =
TWiki::Func::isAnAdmin($wikiName, $topic, $web);
}
}
if ( $allow =~ /\S/ ) {
unless ( _isInList($allow) ) {
return $canChange = 0 unless ( TWiki::Func->can('isAnAdmin') );
return $canChange =
TWiki::Func::isAnAdmin($wikiName, $topic, $web);
}
}
return $canChange = 1;
}
elsif ( $TWiki::cfg{TagMePlugin}{SplitSpace} ) {
# If neither DENY_TAG_CHANGE or ALLOW_TAG_CHANGE is defined, then
# change permission to WebPreferences dictates it.
my $wikiUserName = TWiki::Func::getWikiName();
return $canChange = TWiki::Func::checkAccessPermission(
'CHANGE', $wikiUserName, undef, $TWiki::cfg{WebPrefsTopicName}, $manipWeb,
undef);
}
else {
return $canChange = 1;
}
}
# =========================
sub _renameTag {
my ($attr) = @_;
my $oldTag = defined($attr->{oldtag}) ? $attr->{oldtag} : '';
my $newTag = defined($attr->{newtag}) ? $attr->{newtag} : '';
my $note = defined($attr->{note}) ? $attr->{note} : '';
my $query = TWiki::Func::getCgiQuery();
my $postChangeRequest = $query->param('postChangeRequest') || '';
if ($postChangeRequest) {
return _handlePostChangeRequest( 'rename', $oldTag, $newTag, $note );
}
return _htmlErrorFeedbackChangeMessage( 'rename', $note ) if !_canChange();
$newTag = _makeSafeTag($newTag);
return _wrapHtmlErrorFeedbackMessage( "Please select a tag to rename",
$note )
unless ($oldTag);
return _wrapHtmlErrorFeedbackMessage( "Please enter a new tag name", $note )
unless ($newTag);
my $changeMessage =
"Tag \"$oldTag\" is successfully renamed to \"$newTag\"";
return _modifyTag( $oldTag, $newTag, $changeMessage, $note );
}
# =========================
sub _handlePostChangeRequest {
my ( $mode, $oldTag, $newTag, $note ) = @_;
my $userName = TWiki::Func::getWikiUserName();
my $requestLine = '';
my $message = '';
my $logMessage = '';
my $ctx = TWiki::Func::getContext();
my $inactiveSite = ref $ctx && ( $ctx->{inactive} || $ctx->{content_slave} );
if ( $inactiveSite ) {
$message = "Your request cannot be added to $tagChangeRequestLink " .
"since this web is read-only: $mode, $oldTag, $newTag";
$logMessage = $message . " (requested by $userName)";
}
else {
my $date = TWiki::Time::formatTime(time(), '$day $mon $year', 'gmtime');
if ( $mode eq 'rename' ) {
$requestLine =
"| Rename | $oldTag | $newTag | $userName | $date |";
$message .=
"Your request to rename \"$oldTag\" to \"$newTag\" is added to $tagChangeRequestLink";
$logMessage .=
"Posted tag rename request: from '$oldTag' to '$newTag' (requested by $userName)";
}
elsif ( $mode eq 'delete' ) {
$requestLine =
"| %RED% Delete %ENDCOLOR% | %RED% $oldTag %ENDCOLOR% | | $userName | $date |";
$message .=
"Your request to delete \"$oldTag\" is added to $tagChangeRequestLink";
$logMessage .=
"Posted tag delete request: '$oldTag' (requested by $userName)";
}
elsif ( $mode eq 'create' ) {
$requestLine =
"| %RED% Add %ENDCOLOR% | %RED% $newTag %ENDCOLOR% | | $userName | $date |";
$message .=
"Your request to create \"$newTag\" is added to $tagChangeRequestLink";
$logMessage .=
"Posted tag create request: '$newTag' (requested by $userName)";
}
my ( $meta, $text ) =
TWiki::Func::readTopic( $manipWeb, $tagChangeRequestTopic );
$text =~ s/\s+$//;
$text .= "\n" . $requestLine;
TWiki::Func::saveTopic( $manipWeb, $tagChangeRequestTopic, $meta, $text,
{ comment => 'posted tag change request' } );
}
$message .= _htmlPostChangeRequestFormField();
_writeLog($logMessage);
return _wrapHtmlFeedbackMessage( $message, $note );
}
# =========================
# Default (starting) modify action so we can post a useful feedback message if
# this user is not allowed to change tags.
# Is he can change no feedback message will be shown.
sub _modifyTagInit {
my ( $mode, $attr ) = @_;
my $note = defined($attr->{note}) ? $attr->{note} : '';
return _htmlErrorFeedbackChangeMessage( $mode, $note ) if !_canChange();
return $note;
}
# =========================
sub _deleteTag {
my ($attr) = @_;
my $deleteTag = defined($attr->{oldtag}) ? $attr->{oldtag} : '';
my $note = defined($attr->{note}) ? $attr->{note} : '';
my $query = TWiki::Func::getCgiQuery();
my $postChangeRequest = $query->param('postChangeRequest') || '';
if ($postChangeRequest) {
return _handlePostChangeRequest( 'delete', $deleteTag, undef, $note );
}
return _htmlErrorFeedbackChangeMessage( 'delete', $note ) if !_canChange();
return _wrapHtmlErrorFeedbackMessage( "Please select a tag to delete",
$note )
unless ($deleteTag);
my $changeMessage = "Tag \"$deleteTag\" is successfully deleted";
return _modifyTag( $deleteTag, '', $changeMessage, $note );
}
# =========================
# same as above but to be used inlinr on a topic, for some styles
sub _deleteTheTag {
my ($attr) = @_;
my $deleteTag = defined($attr->{tag}) ? $attr->{tag} : '';
my $note = defined($attr->{note}) ? $attr->{note} : '';
return _htmlErrorFeedbackChangeMessage( 'delete', $note ) if !_canChange();
return _wrapHtmlErrorFeedbackMessage( "Please select a tag to delete",
$note )
unless ($deleteTag);
my $changeMessage = "Tag \"$deleteTag\" is successfully deleted";
$note = _modifyTag( $deleteTag, '', $changeMessage, $note );
return _showDefault(status => $note);
}
# =========================
sub _wrapHtmlFeedbackMessage {
my ( $text, $note ) = @_;
return defined($note) && $note ne '' ?
"$text
" :
"$text";
}
# =========================
sub _wrapHtmlErrorFeedbackMessage {
my ( $text, $note ) = @_;
return _wrapHtmlFeedbackMessage( "$text",
$note );
}
# =========================
sub _wrapHtmlFeedbackInline {
my ($text) = @_;
return " $text";
}
# =========================
sub _wrapHtmlFeedbackErrorInline {
my ($text) = @_;
return _wrapHtmlFeedbackInline("$text");
}
# =========================
sub _wrapHtmlTagControl {
my ($text) = @_;
return "$text";
}
# =========================
sub _wrapHtmlTagMeShowForm {
my ($text) = @_;
return
"";
}
# =========================
sub _htmlErrorFeedbackChangeMessage {
my ( $changeMode, $note ) = @_;
my $errorMessage = '%ICON{"warning"}%';
my $op;
if ( $changeMode =~ /^(create|rename|delete)$/ ) {
$op = $changeMode;
}
else {
$op = 'modify';
}
my $extraNote = '';
if ( $inactiveSite ) {
$errorMessage .= "You cannot $op tags since this web is read-only.";
}
else {
$errorMessage .= " You are not allowed to $op tags";
$extraNote =
"But you may use this form to post a change request to $tagChangeRequestLink";
}
$note = '%BR%' . $note if $note;
$note = $extraNote . $note;
$note .= _htmlPostChangeRequestFormField();
return _wrapHtmlErrorFeedbackMessage( $errorMessage, $note );
}
# =========================
sub _htmlPostChangeRequestFormField {
return '';
}
# =========================
sub _urlEncode {
my $text = shift;
$text =~ s/([^0-9a-zA-Z-_.:~!*'()\/%])/'%'.sprintf('%02x',ord($1))/ge;
return $text;
}
# =========================
sub _urlDecode {
my $text = shift;
$text =~ s/%([\da-f]{2})/chr(hex($1))/gei;
return $text;
}
# =========================
sub _handleMakeText {
### my( $text ) = @_; # do not uncomment, use $_[0] instead
# for compatibility with TWiki 3
return unless ( $TWiki::Plugins::VERSION < 1.1 );
# very crude hack to remove MAKETEXT{"...."}
# Note: parameters are _not_ supported!
$_[0] =~ s/[%]MAKETEXT\{ *\"(.*?)." *}%/$1/go;
}
# =========================
sub _writeDebug {
my ($text) = @_;
TWiki::Func::writeDebug("- ${pluginName}: $text") if $debug;
}
# =========================
sub _writeWarning {
my ($text) = @_;
TWiki::Func::writeWarning("- ${pluginName}: $text");
}
# =========================
sub _writeLog {
my ($theText) = @_;
if ($logAction) {
$TWiki::Plugins::SESSION
? $TWiki::Plugins::SESSION->writeLog( "tagme", "$web.$topic",
$theText )
: TWiki::Store::writeLog( "tagme", "$web.$topic", $theText );
_writeDebug("TAGME action, $web.$topic, $theText");
}
}
# =========================
sub _isGroupMember {
my $group = shift;
return TWiki::Func::isGroupMember ( $group, undef ) if $TWiki::Plugins::VERSION >= 1.2;
return $TWiki::Plugins::SESSION->{user}->isInList($group);
}
# =========================
sub _isInList {
my $list = shift; # we know it is not null
foreach my $name ( split(/[,\s]+/, $list) ) {
$name =~ s/(Main\.|\%MAINWEB\%\.)//go;
return 1 if ( $name eq TWiki::Func::getWikiName(undef) );
# user is listed
return 1 if _isGroupMember( $name );
}
# this user is not in list
return 0;
}
# =========================
sub _TAGMEPLUGIN_USER_AGNOSTIC {
_initialize();
return $userAgnostic ? 'on' : 'off';
}
# =========================
1;
$note