lib/TWiki/Plugins/InterwikiPlugin.pm
changeset 0 414e01d06fd5
child 1 e2915a7cbdfa
equal deleted inserted replaced
-1:000000000000 0:414e01d06fd5
       
     1 # Plugin for TWiki Enterprise Collaboration Platform, http://TWiki.org/
       
     2 #
       
     3 # Copyright (C) 2000-2003 Andrea Sterbini, a.sterbini@flashnet.it
       
     4 # Copyright (C) 2001-2007 Peter Thoeny, peter@thoeny.org
       
     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. For
       
    10 # more details read LICENSE in the root of this distribution.
       
    11 #
       
    12 # This program is distributed in the hope that it will be useful,
       
    13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
       
    14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
       
    15 #
       
    16 # As per the GPL, removal of this notice is prohibited.
       
    17 
       
    18 =pod
       
    19 
       
    20 ---+ package TWiki::Plugins::InterwikiPlugin
       
    21 
       
    22 Recognises and processes special links to other sites defined
       
    23 using "inter-site syntax".
       
    24 
       
    25 The recognized syntax is:
       
    26 <pre>
       
    27        InterSiteName:TopicName
       
    28 </pre>
       
    29 
       
    30 Sites must start with upper case and must be preceded by white
       
    31 space, '-', '*' or '(', or be part of the link expression
       
    32 in a [[link]] or [[link][text]] expression.
       
    33 
       
    34 =cut
       
    35 
       
    36 package TWiki::Plugins::InterwikiPlugin;
       
    37 
       
    38 use strict;
       
    39 
       
    40 require TWiki::Func;    # The plugins API
       
    41 require TWiki::Plugins; # For the API version
       
    42 
       
    43 use vars qw(
       
    44             $VERSION
       
    45             $RELEASE
       
    46             $interWeb
       
    47             $interLinkFormat
       
    48             $sitePattern
       
    49             $pagePattern
       
    50             %interSiteTable
       
    51     );
       
    52 
       
    53 # This should always be $Rev: 14913 (17 Sep 2007) $ so that TWiki can determine the checked-in
       
    54 # status of the plugin. It is used by the build automation tools, so
       
    55 # you should leave it alone.
       
    56 $VERSION = '$Rev: 14913 (17 Sep 2007) $';
       
    57 
       
    58 # This is a free-form string you can use to "name" your own plugin version.
       
    59 # It is *not* used by the build automation tools, but is reported as part
       
    60 # of the version number in PLUGINDESCRIPTIONS.
       
    61 $RELEASE = 'Dakar';
       
    62 
       
    63 BEGIN {
       
    64     # 'Use locale' for internationalisation of Perl sorting and searching - 
       
    65     if( $TWiki::cfg{UseLocale} ) {
       
    66         require locale;
       
    67         import locale ();
       
    68     }
       
    69 }
       
    70 
       
    71 # Read preferences and get all InterWiki Site->URL mappings
       
    72 sub initPlugin {
       
    73     my( $topic, $web, $user, $installWeb ) = @_;
       
    74 
       
    75     $interWeb = $installWeb;
       
    76 
       
    77     # check for Plugins.pm versions
       
    78     if( $TWiki::Plugins::VERSION < 1.026 ) {
       
    79         TWiki::Func::writeWarning( "Version mismatch between InterwikiPlugin and Plugins.pm" );
       
    80         return 0;
       
    81     }
       
    82 
       
    83     # Regexes for the Site:page format InterWiki reference
       
    84     my $man = TWiki::Func::getRegularExpression('mixedAlphaNum');
       
    85     my $ua = TWiki::Func::getRegularExpression('upperAlpha');
       
    86     $sitePattern    = "([$ua][$man]+)";
       
    87     $pagePattern    = "([${man}_\/][$man" . '\.\/\+\_\,\;\:\!\?\%\#\@\-]*?)';
       
    88 
       
    89     # Get plugin preferences from InterwikiPlugin topic
       
    90     $interLinkFormat =
       
    91       TWiki::Func::getPreferencesValue( 'INTERWIKIPLUGIN_INTERLINKFORMAT' ) ||
       
    92       '<a href="$url" title="$tooltip"><noautolink>$label</noautolink></a>';
       
    93 
       
    94     my $interTopic =
       
    95       TWiki::Func::getPreferencesValue( 'INTERWIKIPLUGIN_RULESTOPIC' )
       
    96           || 'InterWikis';
       
    97     ( $interWeb, $interTopic ) =
       
    98       TWiki::Func::normalizeWebTopicName( $interWeb, $interTopic );
       
    99     if( $interTopic =~ s/^(.*)\.// ) {
       
   100         $interWeb = $1;
       
   101     }
       
   102 
       
   103     my $text = TWiki::Func::readTopicText( $interWeb, $interTopic, undef, 1 );
       
   104 
       
   105     # '| alias | URL | ...' table and extract into 'alias', "URL" list
       
   106     $text =~ s/^\|\s*$sitePattern\s*\|\s*(.*?)\s*\|\s*(.*?)\s*\|.*$/_map($1,$2,$3)/mego;
       
   107 
       
   108     $sitePattern = "(" . join( "|", keys %interSiteTable ) . ")";
       
   109     return 1;
       
   110 }
       
   111 
       
   112 sub _map {
       
   113     my( $site, $url, $tooltip ) = @_;
       
   114     if( $site ) {
       
   115         $interSiteTable{$site}{url} = $url || '';
       
   116         $interSiteTable{$site}{tooltip} = $tooltip || '';
       
   117     }
       
   118     return '';
       
   119 }
       
   120 
       
   121 sub preRenderingHandler {
       
   122     # ref in [[ref]] or [[ref][
       
   123     $_[0] =~ s/(\[\[)$sitePattern:$pagePattern(\]\]|\]\[[^\]]+\]\])/_link($1,$2,$3,$4)/geo;
       
   124     # ref in text
       
   125     $_[0] =~ s/(^|[\s\-\*\(])$sitePattern:$pagePattern(?=[\s\.\,\;\:\!\?\)\|]*(\s|$))/_link($1,$2,$3)/geo;
       
   126 }
       
   127 
       
   128 sub _link {
       
   129     my( $prefix, $site, $page, $postfix ) = @_;
       
   130 
       
   131     $prefix ||= '';
       
   132     $site ||= '';
       
   133     $page ||= '';
       
   134     $postfix ||= '';
       
   135 
       
   136     my $text = $prefix;
       
   137     if( defined( $interSiteTable{$site} ) ) {
       
   138         my $tooltip = $interSiteTable{$site}{tooltip};
       
   139         my $url = $interSiteTable{$site}{url};
       
   140         $url .= $page unless( $url =~ /\$page/ );
       
   141         my $label = '$site:$page';
       
   142 
       
   143         if( $postfix ) {
       
   144             # [[...]] or [[...][...]] interwiki link
       
   145             $text = '';
       
   146             if( $postfix =~ /^\]\[([^\]]+)/ ) {
       
   147                 $label = $1;
       
   148             }
       
   149         }
       
   150 
       
   151         my $format = $interLinkFormat;
       
   152         $format =~ s/\$url/$url/g;
       
   153         $format =~ s/\$tooltip/$tooltip/g;
       
   154         $format =~ s/\$label/$label/g;
       
   155         $format =~ s/\$site/$site/g;
       
   156         $format =~ s/\$page/$page/g;
       
   157         $text .= $format;
       
   158     } else {
       
   159         $text .= "$site\:$page$postfix";
       
   160     }
       
   161     return $text;
       
   162 }
       
   163 
       
   164 1;