1 rizwank 1.1 # Plugin for TWiki Collaboration Platform, http://TWiki.org/
  2             #
  3             # Copyright (C) 2000-2001 Andrea Sterbini, a.sterbini@flashnet.it
  4             # Copyright (C) 2002-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.ai.mit.edu/copyleft/gpl.html
 16             #
 17             # =========================
 18             #
 19             # This plugin replaces smilies with small smilies bitmaps
 20             # see TWiki.SmiliesPlugin
 21             #
 22 rizwank 1.1 # =========================
 23             package TWiki::Plugins::SmiliesPlugin;
 24             # =========================
 25             
 26             use vars qw($web $topic $user $installWeb $VERSION $debug
 27                         %smiliesUrls %smiliesEmotions
 28                         $smiliesPattern $allPattern $smiliesPubUrl $smiliesFormat );
 29             
 30             $VERSION = '1.003';
 31             
 32             $smiliesPattern = '^\s*\|\s*<nop>(?:\&nbsp\;)?([^\s|]+)\s*\|\s*%ATTACHURL%\/([^\s]+)\s*\|\s*"([^"|]+)"\s*\|\s*$';
 33             #                          smilie       url            emotion
 34             $allPattern = "";
 35             $smiliesPubUrl = "";
 36             
 37             # =========================
 38             sub initPlugin
 39             {
 40                 ( $topic, $web, $user, $installWeb ) = @_;
 41             
 42                 # Get plugin debug flag
 43 rizwank 1.1     $debug = &TWiki::Func::getPreferencesFlag( "SMILIESPLUGIN_DEBUG" );
 44             
 45                 # Get plugin preferences
 46                 $smiliesFormat = &TWiki::Func::getPreferencesValue( "SMILIESPLUGIN_FORMAT" ) 
 47             					|| '<img src="$url" alt="$tooltip" title="$tooltip" border="0" />';
 48             
 49                 my $topic = &TWiki::Func::getPreferencesValue( "SMILIESPLUGIN_TOPIC" ) 
 50             					|| "$installWeb.SmiliesPlugin"; 
 51             
 52                 my $web = $installWeb;
 53                 if( $topic =~ /(.+)\.(.+)/ ) {
 54                     $web = $1;
 55                     $topic = $2;
 56                 }
 57             
 58                 $allPattern = "(";
 59                 foreach( split( /\n/, TWiki::Func::readTopic( $web, $topic ) ) ) {
 60                     if( m/$smiliesPattern/ ) {
 61                         $allPattern .= "\Q$1\E|";
 62                         $smiliesUrls{$1}     = $2;
 63                         $smiliesEmotions{$1} = $3;
 64 rizwank 1.1         }
 65                 }
 66                 $allPattern =~ s/\|$//o;
 67                 $allPattern .= ")";
 68                 $smiliesPubUrl = TWiki::Func::getUrlHost() . TWiki::Func::getPubUrlPath() .
 69                                  "/$installWeb/SmiliesPlugin";
 70             
 71                 # Initialization OK
 72                 return 1;
 73             }
 74             
 75             # =========================
 76             sub commonTagsHandler
 77             {
 78             #    my ( $text, $topic, $web ) = @_;
 79                 $_[0] =~ s/%SMILIES%/&allSmiliesTable()/geo;
 80             }
 81             
 82             # =========================
 83             sub outsidePREHandler
 84             {
 85 rizwank 1.1 #    my ( $text, $web ) = @_;
 86             
 87                 $_[0] =~ s/(\s|^)$allPattern(?=\s|$)/&renderSmilie( $1, $2 )/geo;
 88             }
 89             
 90             # =========================
 91             sub renderSmilie
 92             {
 93                 my ( $thePre, $theSmilie ) = @_;
 94             
 95                 return $thePre unless $theSmilie;  # return unless initialized
 96             
 97                 my $text = "$thePre$smiliesFormat";
 98                 $text =~ s/\$emoticon/$theSmilie/go;
 99                 $text =~ s/\$tooltip/$smiliesEmotions{$theSmilie}/go;
100                 $text =~ s/\$url/$smiliesPubUrl\/$smiliesUrls{$theSmilie}/go;
101             
102                 return $text;
103             }
104             
105             # =========================
106 rizwank 1.1 sub allSmiliesTable
107             {
108                 my $text = "| *What to Type* | *Graphic That Will Appear* | *Emotion* |\n";
109             
110             #    my ($k, $a, $b);
111                 foreach $k ( sort { $smiliesEmotions{$b} cmp $smiliesEmotions{$a} }
112                             keys %smiliesEmotions )
113                 {
114                     $text .= "| <nop>$k | $k | ". $smiliesEmotions{$k} ." |\n";
115                 }
116                 return $text;
117             }
118             
119             # =========================
120             
121             1;