#
# 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 General Public License for more details, published at 
# http://www.gnu.org/copyleft/gpl.html
#
# =========================
#
# Allow usernames to be used as WikiWords, by detecting usernames and Wikifying
# them.
#  -- wmertens@cisco.com
#
# Known problems:
#   * This cannot honor the <noautolink> tag, but that's hardly used.
#   * There is lots of duplicated code here
#   * It's somewhat slower than patching TWiki.pm
#
# =========================
package TWiki::Plugins::LoginNamePlugin;

use strict;

# =========================
use vars qw(
        $web $topic $user $installWeb $VERSION 
	$newTopicFontColor $newTopicBgColor $userWebname $scriptUrlPath
    );

$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 LoginNamePlugin and Plugins.pm" );
        return 0;
    }

    # Find out stuff
    $userWebname = &TWiki::Func::getMainWebname;
    $scriptUrlPath = &TWiki::Func::getScriptUrlPath;
    $newTopicFontColor = &TWiki::Func::getPreferencesValue("NEWTOPICFONTCOLOR");
    if ($newTopicFontColor eq "") { $newTopicFontColor="#0000FF"; }
    $newTopicBgColor = &TWiki::Func::getPreferencesValue("NEWTOPICBGCOLOR");
    if ($newTopicBgColor eq "") { $newTopicBgColor="#FFFFCE"; }

    # Plugin correctly initialized
    #&TWiki::Func::writeDebug( "- TWiki::Plugins::EmptyPlugin::initPlugin( $web.$topic ) is OK" ) if $debug;
    return 1;
}

# =========================

# This is mostly ripped from internalLink, but it adds a template link to edit
# mode and skips most of the useless stuff.
sub userLink
{
    my( $thePreamble, $theWeb, $theTopic, $theLinkText, $theAnchor, $doLink ) = @_;
    # $thePreamble is heading space
    # $doLink is boolean, false suppress link for non-existing pages

    # Add <nop> before WikiWord inside text to prevent double links
    $theLinkText =~ s/([\s\(])([A-Z]+[a-z]+[A-Z])/$1<nop>$2/go;

    my $exist = &TWiki::Func::topicExists( $theWeb, $theTopic );
    my $text = $thePreamble;
    if( $exist) {
        if( $theAnchor ) {
	    # Ripped from makeAnchorName
            my $anchor = $theAnchor;
	    $anchor =~ s/^[\s\#\_]*//o;       # no leading space nor '#', '_'
            $anchor =~ s/[\s\_]*$//o;         # no trailing space, nor '_'
	    $anchor =~ s/<\w[^>]*>//goi;      # remove HTML tags
            $anchor =~ s/[^a-zA-Z0-9]/_/go;   # only allowed chars
	    $anchor =~ s/__+/_/go;            # remove excessive '_'
            $anchor =~ s/^(.{32})(.*)$/$1/o;  # limit to 32 chars

            $text .= "<a href=\"$scriptUrlPath/view/"
                  .  "$theWeb/$theTopic\#$anchor\">$theLinkText<\/a>";
            return $text;
        } else {
            $text .= "<a href=\"$scriptUrlPath/view/"
                  .  "$theWeb/$theTopic\">$theLinkText<\/a>";
            return $text;
        }

    } elsif( $doLink ) {
        $text .= "<span style='background : $newTopicBgColor;'>"
              .  "<font color=\"$newTopicFontColor\">$theLinkText</font></span>"
              .  "<a href=\"$scriptUrlPath/edit/$theWeb/$theTopic?topicparent=$userWebname.TWikiUsers&templatetopic=NewUserTemplate\">?</a>";
        return $text;

    } else {
        $text .= $theLinkText;
        return $text;
    }
}

# =========================
# Ripped from specificLink, and moved [] removal to here to reduce large searches
sub specificUserLink
{
    my $theText = shift;

    # format: [[$theLink]]
    # format: [[$theLink][$theText]]
    $theText =~ /\[\[([^\]]+)\]\[?([^\]]*)\]?\]/o;
    my $theLink = $1;
    $theText = $2;

    (my $baz = "foo") =~ s/foo//;       # reset $1, defensive coding
    $theLink =~ s/^([A-Z]+[a-z0-9]*)\.//o;
    my $webname = $1 || $web;            # extract 'Web.'
    (my $baz = "foo") =~ s/foo//;       # reset $1, defensive coding
    $theLink =~ s/(\#[a-zA-Z_0-9\-]*$)//o;
    my $anchor = $1 || "";              # extract '#anchor'
    my $topicname = $theLink || $topic;  # remaining is topic

    $theText = $theLink unless $theText;
    if( ! $topicname ) {
        return "$theText"; # no link if no topic
    }

    return userLink( "", $webname, $topicname, $theText, $anchor, 1 );
}

# =========================
# A username is 2 to 8 lowercase chars followed by non-alphanumerics
sub outsidePREHandler
{
	if ($web eq $userWebname) {
		s/(\[\[[a-z]{2,8}(\#[a-zA-Z0-9_]+)?\](\[[^\]]+\])?\])/&specificUserLink($1)/geo;
	}
	s/(\[\[$userWebname\.[a-z]{2,8}(\#[a-zA-Z0-9_]+)?\](\[[^\]]+\])?\])/&specificUserLink($1)/geo;
	$_[0] =~ s/([\s\(])($userWebname)\.([a-z]{2,8})(\#[a-zA-Z0-9_]*)/&userLink($1,$2,$3,"$3$4",$4,1)/geo;
	$_[0] =~ s/([\s\(])($userWebname)\.([a-z]{2,8})([^a-zA-Z0-9])/&userLink($1,$2,$3,"$3","",1).$4/geo;
	$_[0] =~ s/(\[\[)($userWebname)\.([a-z]{2,8})(\])/&userLink($1,$2,$3,"$3","",1).$4/geo;
}

# =========================

1;