# perl -w
# TWiki WikiClone ($wikiversion has version info)
#
# Copyright (C) 2000-2001 Andrea Sterbini, a.sterbini@flashnet.it
# Copyright (C) 2001 Peter Thoeny, Peter@Thoeny.com
#
# 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.
#
# 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. See the
# GNU Gener al Public License for more details, published at
# http://www.gnu.org/copyleft/gpl.html
#
# =========================
#
#
# Each plugin is a package that contains the subs:
#
# initPlugin ( $topic, $web, $user, $installWeb )
# commonTagsHandler ( $text, $topic, $web )
# startRenderingHandler( $text, $web )
# outsidePREHandler ( $text )
# insidePREHandler ( $text )
# endRenderingHandler ( $text )
#
# initPlugin is required, all other are optional.
# For increased performance, all handlers except initPlugin are
# disabled. To enable a handler remove the leading DISABLE_ from
# the function name.
#
# NOTE: To interact with TWiki use the official TWiki functions
# in the &TWiki::Func module. Do not reference any functions or
# variables elsewhere in TWiki!!
# =========================
package TWiki::Plugins::CompareWebsPlugin;
# =========================
use vars qw(
$web $topic $user $installWeb $VERSION $debug
$exampleCfgVar @allWebs %topics
);
$VERSION = '1.000';
# =========================
sub initPlugin
{
( $topic, $web, $user, $installWeb ) = @_;
# check for Plugins.pm versions
if( $TWiki::Plugins::VERSION < 1 ) {
&TWiki::Func::writeWarning( "Version mismatch between CompareWebsPlugin and Plugins.pm" );
return 0;
}
# Get plugin preferences, the variable defined by:
$exampleCfgVar = &TWiki::Prefs::getPreferencesValue( "EMPTYPLUGIN_EXAMPLE" ) || "default";
# Get plugin debug flag
$debug = &TWiki::Func::getPreferencesFlag( "COMPAREWEBS_DEBUG" );
# Plugin correctly initialized
&TWiki::Func::writeDebug( "- TWiki::Plugins::CompareWebsPlugin::initPlugin( $web.$topic ) is OK" ) if 1;
return 1;
}
# =========================
sub DISABLE_commonTagsHandler
{
### my ( $text, $topic, $web ) = @_; # do not uncomment, use $_[0], $_[1]... instead
&TWiki::Func::writeDebug( "- CompareWebsPlugin::commonTagsHandler( $_[2].$_[1] )" ) if 1;
# This is the place to define customized tags and variables
# Called by sub handleCommonTags, after %INCLUDE:"..."%
# do custom extension rule, like for example:
# $_[0] =~ s/%XYZ%/&handleXyz()/geo;
# $_[0] =~ s/%XYZ{(.*?)}%/&handleXyz($1)/geo;
}
# =========================
sub startRenderingHandler
{
### my ( $text, $web ) = @_; # do not uncomment, use $_[0], $_[1] instead
writeDebug( "- CompareWebsPlugin::startRenderingHandler( $_[1].$topic )" );
# This handler is called by getRenderedVersion just before the line loop
$_[0] =~ s/%COMPAREWEBS{(.*?)}%/&compareWebs($1)/geo;
# do custom extension rule, like for example:
# $_[0] =~ s/old/new/go;
}
# =========================
sub DISABLE_outsidePREHandler
{
### my ( $text ) = @_; # do not uncomment, use $_[0] instead
# &TWiki::Func::writeDebug( "- XSLXMLPlugin::outsidePREHandler( $web.$topic )" ) if $debug;
# This handler is called by getRenderedVersion, in loop outside of tag.
# This is the place to define customized rendering rules.
# Note: This is an expensive function to comment out.
# Consider startRenderingHandler instead
}
# =========================
sub DISABLE_insidePREHandler
{
### my ( $text ) = @_; # do not uncomment, use $_[0] instead
# &TWiki::Func::writeDebug( "- CompareWebsPlugin::insidePREHandler( $web.$topic )" ) if $debug;
# This handler is called by getRenderedVersion, in loop inside of tag.
# This is the place to define customized rendering rules.
# Note: This is an expensive function to comment out.
# Consider startRenderingHandler instead
}
# =========================
sub endRenderingHandler
{
### my ( $text ) = @_; # do not uncomment, use $_[0] instead
&TWiki::Func::writeDebug( "- CompareWebsPlugin::endRenderingHandler( $web.$topic )" ) if $debug;
# This handler is called by getRenderedVersion just after the line loop
}
sub writeDebug
{
&TWiki::Func::writeDebug(@_) if $debug;
}
sub trimSpaces
{
my $string = $_[0];
$string =~ s/^\s*(.*?)\s*$/$1/;
return $string;
}
sub trimQuotes
{
my $string = $_[0];
if ( ($string =~ /^'(.*?)'$/) || ($string =~ /^"(.*?)"$/) ) {
$string =~ s/^[',"](.*?)[',"]$/$1/;
}
return $string;
}
sub setDefaults {
my ($args) = @_;
my @nameValuePairs= split /,/, $args;
foreach my $pair (@nameValuePairs) {
my ($name, $value) = split /=/, $pair;
$name = &trimQuotes(&trimSpaces($name));
$value = &trimQuotes(&trimSpaces($value));
$args{$name} = $value;
}
if ($args{webs}) {
$args{webs} =~ s/\s+/ /g; # remove excess spaces
my @asArray = (split / /, $args{webs});
$args{webs} = \@asArray;
} else {
my @asArray = &TWiki::Func::getPublicWebList();
$args{webs} = \@asArray;
}
foreach (@{$args{webs}}) {
$_ = trimQuotes($_);
}
my @allWebs = @{$args{webs}};
# print "WEBS= ".join(",", @allWebs);
my %argsAndDefaults = ( webs => \@allWebs,
startTable=> "\n"."| WikiWord | ".join(" | ",@{$args{webs}})." | ",
endTable=> "
",
startRowSeparator=> "",
endRowSeparator=> "
",
rowLeader=> "%TOPIC%",
startColumnSeparator=> "",
endColumnSeparator=> " | ",
doesExistFormat=> "Y",
doesNotExistFormat=> "-"
);
# Bring over any key not already defined
foreach my $key (keys %argsAndDefaults) {
if (! defined $args{$key}) {
$args{$key} = $argsAndDefaults{$key};
}
}
return %args;
}
# =========================
sub compareWebs {
my ($args) = @_;
@allWebs = ();
%topics = ();
my %args = setDefaults($args);
# my @allWebs = @{$args{webs}};
# print "WEBS= ".join(",", @allWebs);
foreach my $web (@{$args{webs}}) {
if ($#($args{topics}) = 0) {
my @allTopicsInCurrentWeb = &TWiki::Func::getTopicList($web);
foreach my $topic (@allTopicsInCurrentWeb) {
foundTopicInWeb($topic, $web);
}
} else {
my @allTopicsThatUserIsInterestedIn = @{$args{topics}};
foreach my $topic (@allTopicsThatUserIsInterestedIn) {
if (TWiki::Func::topicExists($web, $topic)) {
foundTopicInWeb($topic, $web);
}
}
}
}
# return getResultsForDebug();
return getResults($args{webs},
$args{startTable}, $args{endTable},
$args{startRowSeparator}, $args{endRowSeparator},
$args{rowLeader},
$args{startColumnSeparator}, $args{endColumnSeparator},
$args{doesExistFormat}, $args{doesNotExistFormat}
);
}
sub debugSettings {
writeDebug("startTable=$args(startTable)");
writeDebug("endTable=$args{endTable}");
writeDebug("startRowSep=$args{startRowSeparator}");
writeDebug("endRowSep=$args{endRowSeparator}");
writeDebug("rowLeader=$args{rowLeader},");
writeDebug("startColumnSeparator=$args{startColumnSeparator}");
writeDebug("endColumnSeparator=$args{endColumnSeparator}");
writeDebug("doesExistFormat=$args{doesExistFormat}");
writeDebug("doesNotExistFormat=$args{doesNotExistFormat}");
}
# TODO Would like to have passed in the column delimiters and been able to use the TWiki table format using '|'.
# This was not possible because TWiki did not render as a table once it started reading.
sub getResults {
my ($websRef,
$startTable, $endTable, # through subs
$startRowSeparator, $endRowSeparator,
$rowLeader, # through subs
$startColumnSeparator, $endColumnSeparator,
$doesExistFormat, $doesnotExistFormat) = @_; # through subs
my @allWebs = @{$websRef};
writeDebug( "webs = ". join("\n\t", @allWebs).
"\n startTable = ".$startTable.
"\n endTable = ".$endTable.
"\n startRowSeparator = ".$startRowSeparator.
"\n endRowSeparator = ".$endRowSeparator.
"\n rowLeader = ".$rowLeader.
"\n startColumnSeparator = ".$startColumnSeparator.
"\n endColumnSeparator = ".$endColumnSeparator.
"\n doesExistFormat = ".$doesExistFormat.
"\n doesnotExistFormat = ".$doesnotExistFormat );
my $results;
$results=$startTable;
my $allWebsCounter;
foreach my $topic (sort keys %topics) {# sets each key of %topic to $_ in turn
#$results .= " $startRowSeparator $startColumnSeparator". $topic ." $endColumnSeparator ";
my $rowLeaderValue = subs("", $topic, $rowLeader);
$results.=" $startRowSeparator $startColumnSeparator". $rowLeaderValue." $endColumnSeparator ";
my @websThatHaveKey = @{$topics{$topic}};
my $maxCount=scalar(@allWebs);
$allWebsCounter = 0;
foreach my $webCouldExist (@allWebs) {# pick the first that actually exists (ie loops through AT,AB,BC,AA,EI)
$results .=" $startColumnSeparator ";
my $webDoesExist = $websThatHaveKey[$allWebsCounter]; #$allWebsCounter
# print "\tLooking to see whether it is the same as $webDoesExist\n";
# if the first that actually exists is not the first that could then increment allWebsCounter
# until you get one that does match
# compare the picked one to each that could exist.
if ($webDoesExist && ($webCouldExist eq $webDoesExist)) {
my $doesExistValue = subs($webDoesExist, $topic, $doesExistFormat);
&TWiki::Func::writeDebug($doesExistValue);
$results.= $doesExistValue."$endColumnSeparator "; # [[$webDoesExist.$topic]]
$allWebsCounter++;
} else {
#$results.=" $endColumnSeparator";
my $doesnotExistValue = subs($webDoesExist, $topic, $doesnotExistFormat);
&TWiki::Func::writeDebug($doesnotExistValue);
$results.=$doesnotExistValue." $endColumnSeparator";
}
}
$results .= "$endRowSeparator\n";
}
$results.=$endTable;
return $results;
}
# TODO Would like to have passed in the column delimiters and been able to use the TWiki table format using '|'.
# This was not possible because TWiki did not render as a table once it started reading.
sub getResultsForDebug {
my $results;
$results .= "==================\n";
foreach (sort keys %topics) {
# sets each element of %topic to $_ in turn
my $key = $_;
my $joiner = ".".$key;
$results .= " | ". $key ." | ". join($joiner." | ", @{$topics{$key}}).$joiner." |\n";
}
return $results;
}
sub foundTopicInWeb
{
my ($topic, $web)= @_;
# print "DOES: $web.$topic \n";
push @{$topics{$topic}}, $web;
}
sub subs {
my ($web, $topic, $string) =@_;
$string =~ s/&#(.*?);/chr($1)/eg;
$string =~ s/%WEB%/$web/g;
$string =~ s/%THEWEB%/$web/g;
$string =~ s/\$web/$web/g;
$string =~ s/%TOPIC%/$topic/g;
$string =~ s/%THETOPIC%/$topic/g;
$string =~ s/\$topic/$topic/g;
return $string;
}
1;