1 rizwank 1.1 # Plugin for TWiki Collaboration Platform, http://TWiki.org/
  2             #
  3             # Copyright (C) 2000-2003 Andrea Sterbini, a.sterbini@flashnet.it
  4             # Copyright (C) 2001-2004 Peter Thoeny, peter@thoeny.com
  5             #
  6             # This program is free software; you can redistribute it and/or
  7             # modify it under the terms of the GNU General Public License
  8             # as published by the Free Software Foundation; either version 2
  9             # of the License, or (at your option) any later version.
 10             #
 11             # This program is distributed in the hope that it will be useful,
 12             # but WITHOUT ANY WARRANTY; without even the implied warranty of
 13             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 14             # GNU General Public License for more details, published at
 15             # http://www.gnu.org/copyleft/gpl.html
 16             #
 17             # =========================
 18             # Interwiki Link Plugin:
 19             #
 20             # Here we handle inter-site links, i.e. links going outside TWiki
 21             # The recognized syntax is:
 22 rizwank 1.1 #       InterSiteName:TopicName
 23             # and inserts <a href="URL/TopicName">InterSiteName:TopicName</a>
 24             # link, where URL is obtained by a topic that lists all
 25             # InterSiteName/URL pairs.
 26             # Inter-site name convention: Sites must start with upper case
 27             # and must be preceeded by white space, '-', '*' or '('
 28             #
 29             # =========================
 30             package TWiki::Plugins::InterwikiPlugin;
 31             # =========================
 32             
 33             use vars qw(
 34                     $web $topic $user $installWeb  $VERSION $debug
 35                     $interSiteLinkRulesTopicName $suppressTooltip
 36                     $prefixPattern $upperAlpha $mixedAlphaNum $sitePattern $pagePattern $postfixPattern
 37                     %interSiteTable $debug
 38                 );
 39             
 40             $VERSION = '1.005'; # 16 Feb 2004
 41             $interSiteLinkRulesTopicName = "InterWikis";
 42             
 43 rizwank 1.1 # 'Use locale' for internationalisation of Perl sorting and searching - 
 44             # main locale settings are done in TWiki::setupLocale
 45             BEGIN {
 46                 # Do a dynamic 'use locale' for this module
 47                 if( $TWiki::useLocale ) {
 48                     require locale;
 49             	import locale ();
 50                 }
 51             }
 52             
 53             # Regexes for the Site:page format InterWiki reference - updated to support
 54             # 8-bit characters in both parts - see Codev.InternationalisationEnhancements
 55             $prefixPattern  = '(^|[\s\-\*\(])';
 56             if( $TWiki::Plugins::VERSION >= 1.020 ) {
 57                 $upperAlpha    = TWiki::Func::getRegularExpression("upperAlpha");
 58                 $mixedAlphaNum = TWiki::Func::getRegularExpression("mixedAlphaNum");
 59             } else {
 60                 $upperAlpha    = $TWiki::upperAlpha;
 61                 $mixedAlphaNum = $TWiki::mixedAlphaNum;
 62             }
 63             $sitePattern    = "([${upperAlpha}][${mixedAlphaNum}]+)";
 64 rizwank 1.1 $pagePattern    = "([${mixedAlphaNum}_\/][${mixedAlphaNum}" . '\+\_\.\,\;\:\!\?\/\%\#-]+?)';
 65             $postfixPattern = '(?=[\s\.\,\;\:\!\?\)]*(\s|$))';
 66             
 67             # =========================
 68             # Plugin startup - read preferences and get all InterWiki Site->URL mappings
 69             sub initPlugin
 70             {
 71                 ( $topic, $web, $user, $installWeb ) = @_;
 72             
 73                 # check for Plugins.pm versions
 74                 if( $TWiki::Plugins::VERSION < 1 ) {
 75                     &TWiki::Func::writeWarning( "Version mismatch between InterwikiPlugin and Plugins.pm" );
 76                     return 0;
 77                 }
 78             
 79                 # Get plugin preferences from InterwikiPlugin topic
 80                 my $interFileName = &TWiki::Func::getPreferencesValue( "INTERWIKIPLUGIN_RULESTOPIC" ) 
 81                                     || "$installWeb.$interSiteLinkRulesTopicName";
 82                 $suppressTooltip  = &TWiki::Func::getPreferencesFlag( "INTERWIKIPLUGIN_SUPPRESSTOOLTIP" );
 83                 $debug            = &TWiki::Func::getPreferencesFlag( "INTERWIKIPLUGIN_DEBUG" );
 84             
 85 rizwank 1.1     # get the Interwiki site->url map topic
 86                 my $InterFile = '';
 87                 my $dataDir = &TWiki::Func::getDataDir();
 88                 if( $interFileName =~ m/^([^.]+)\.([^.]+)$/ ) {
 89                     $InterFile = "$dataDir/$1/$2.txt"; 	
 90                 } elsif( $interFileName =~ m/^([^.]+)$/ ) {
 91                     $InterFile = "$dataDir/$installWeb/$1.txt"; 
 92                 } else {
 93                     return 0;
 94                 }
 95             
 96                 $InterFile =~ s/%MAINWEB%/&TWiki::Func::getMainWebname()/geo;
 97                 $InterFile =~ s/%TWIKIWEB%/&TWiki::Func::getTwikiWebname/geo;
 98                 &TWiki::Func::writeDebug( "- InterwikiPlugin, rules file: $InterFile" ) if $debug;
 99             
100                 # FIXME: use readWebTopic
101                 open(IN, "<$InterFile") or return 0;  # FIXME: Later warn?
102                 my @data = <IN>;
103                 close IN;
104             
105                 # grep "| alias | URL | ..." table and extract into "alias", "URL" list
106 rizwank 1.1     # FIXME: Should be able to do this pipeline with just one regex match
107                 @data = map { split /\s+/, $_, 2 }
108                         map { s/^\|\s*$sitePattern\s*\|\s*(.*?)\s*\|\s*(.*?)\s*\|.*$/$1 $2 $3/os ; $_ }
109                         grep { m/^\|\s*$sitePattern\s*\|.*?\|.*?\|/o } @data;
110                 if( $debug ) {
111                     my $tmp = join(", " , @data );
112                     &TWiki::Func::writeDebug( "- InterwikiPlugin, table: $tmp" );
113                 }
114                 %interSiteTable  = @data;
115             
116                 # Plugin correctly initialized
117                 &TWiki::Func::writeDebug( "- TWiki::Plugins::InterwikiPlugin::initPlugin( $web.$topic ) is OK" ) if $debug;
118                 return 1;
119             }
120             
121             # =========================
122             sub startRenderingHandler
123             {
124             ### my ( $text, $web ) = @_;   # do not uncomment, use $_[0], $_[1] instead
125                 &TWiki::Func::writeDebug( "- InterwikiPlugin::startRenderingHandler( $_[1] )" ) if $debug;
126             
127 rizwank 1.1     $_[0] =~ s/(\[\[)$sitePattern:$pagePattern(\]\]|\]\[| )/&handleInterwiki($1,$2,$3,$4)/geo;
128                 $_[0] =~ s/$prefixPattern$sitePattern:$pagePattern$postfixPattern/&handleInterwiki($1,$2,$3,"")/geo;
129             }
130             
131             # =========================
132             sub handleInterwiki
133             {
134                 my( $thePrefix, $theSite, $theTopic, $thePostfix ) = @_;
135             
136                 &TWiki::Func::writeDebug( "- InterwikiPlugin::handleInterwikiSiteLink: (site: $theSite), (topic: $theTopic)" ) if $debug;
137             
138                 my $text = "";
139                 if( defined( $interSiteTable{ $theSite } ) ) {
140                     my( $url, $help ) = split( /\s+/, $interSiteTable{ $theSite }, 2 );
141                     my $title = "";
142                     if( ! $suppressTooltip ) {
143                         $help =~ s/<nop>/&nbsp;/goi;
144                         $help =~ s/[\"\<\>]*//goi;
145                         $help =~ s/\$page/$theTopic/go;
146                         $title = " title=\"$help\"";
147                     }
148 rizwank 1.1         &TWiki::Func::writeDebug( "  (url: $url), (help: $help)" ) if $debug;
149                     if( $url =~ s/\$page/$theTopic/go ) {
150                         $text = $url;
151                     } else {
152                         $text = "$url$theTopic";
153                     }
154                     if( $thePostfix ) {
155                         $text = "$thePrefix$text][";
156                         $text .= "$theSite\:$theTopic]]" if( $thePostfix eq "]]" );
157                     } else {
158                         $text = "$thePrefix<a href=\"$text\"$title>$theSite\:$theTopic</a>";
159                     }
160                 } else {
161                     $text = "$thePrefix$theSite\:$theTopic$thePostfix";
162                 }
163                 return $text;
164             }
165             
166             # =========================
167             
168             1;