Tags:
create new tag
, view all tags
Compare the two revisions to see what was changed to implement weighted search. (Unfortunately, it's based on an older release.)

# =========================
sub _queryTag
{
    my( $attr ) = @_;
    my $qWeb      = TWiki::Func::extractNameValuePair( $attr, 'web' );
    my $qTopic    = TWiki::Func::extractNameValuePair( $attr, 'topic' );
    my $qTag      = TWiki::Func::extractNameValuePair( $attr, 'tag' );
    my $qBy       = TWiki::Func::extractNameValuePair( $attr, 'by' );
    my $noRelated = TWiki::Func::extractNameValuePair( $attr, 'norelated' );
    my $noTotal   = TWiki::Func::extractNameValuePair( $attr, 'nototal' );
    my $sort      = TWiki::Func::extractNameValuePair( $attr, 'sort' ) || 'tagcount';
    my $format    = TWiki::Func::extractNameValuePair( $attr, 'format' ) || $tagQueryFormat;
    my $separator = TWiki::Func::extractNameValuePair( $attr, 'separator' ) || "\n";
    my $minSize   = TWiki::Func::extractNameValuePair( $attr, 'minsize' );
    my $maxSize   = TWiki::Func::extractNameValuePair( $attr, 'maxsize' );

    return '__Note:__ Please select a tag' unless( $qTag );

    my $topicsRegex = '';
    if( $qTopic ) {
        $topicsRegex = $qTopic;
        $topicsRegex =~ s/, */\|/go;
        $topicsRegex =~ s/\*/\.\*/go;
        $topicsRegex = '^.*\.(' . $topicsRegex . ')$';
    }
    $qBy = '' unless( $qBy );
    $qBy = '' if( $qBy eq 'all' );
    my $by = $qBy;
    $by = $user if( $by eq 'me' );
    $format =~ s/([^\\])\"/$1\\\"/go;
    $separator =~ s/\$n\b/\n/go;
    $separator =~ s/\$n\(\)/\n/go;
    $maxSize = 180 unless( $maxSize ); # Max % size of font
    $minSize =  90 unless( $minSize );

    # Positive/negative multitag ranking. FWM, 01-Mar-2008
    my @qTagSplit = split( /([, +-]+)/, ' ' . $qTag);
    my %qTags;
    while (defined($qTagSplit[0]) && length($qTagSplit[0])) { shift @qTagSplit; }
    while (@qTagSplit > 0) {
        my $elem = shift @qTagSplit;
        my $signum = 1;
        if ($elem =~ m/([, +-])$/o) {
            if ($1 eq '-') { $signum = -1; }
            (defined($elem = shift @qTagSplit)) or last;
        }
        $qTags{$elem} = $signum;
    }

    # SMELL: Quick hack, should be done with nice data structure
    my $text = '';
    my %tagVotes = ();
    my %topicTags = ();
    my %related = ();
    my $tag = '';
    my $num = '';
    my $users = '';
    my @tags = ();
    my $webTopic = '';
    my $votes = 0;
    foreach $webTopic ( _getTagInfoList() ) {
        next if( $qWeb && $webTopic !~ /^$qWeb\./  );
        next if( $topicsRegex && $webTopic !~ /$topicsRegex/ );
        my @tagInfo = _readTagInfo( $webTopic );
        @tags = ();
        foreach $line ( @tagInfo ) {
            if( $line =~ /^0*([0-9]+), ([^,]+), (.*)/ ) {
                $num = $1;
                $tag = $2;
                $users = $3;
                push( @tags, $tag );
                # Apply our +/- tag ranking. FWM, 01-Mar-2008
                my $signum = $qTags{$tag};
                if(defined $signum) {
                    $votes = $tagVotes{$webTopic} || 0;
                    $tagVotes{$webTopic} = $votes + ($num * $signum)
                        unless( $by && $users !~ /$by/ );
                }
            }
        }
        $votes = $tagVotes{$webTopic};
        if( defined($votes) && ($votes > 0) ) {
            $topicTags{$webTopic} = [ sort( @tags ) ];
            foreach $tag ( @tags ) {
                $num = $related{$tag} || 0;
                $related{$tag} = $num + 1;
            }
        }
        # We might have negative tags to get rid of. FWM, 01-Mar-2008
        elsif (defined $votes) {
            delete $tagVotes{$webTopic};
        }
    }

    return "__Note:__ No topics found tagged with \"$qTag\"" unless( scalar keys( %tagVotes ) );

    # related tags
    unless( $noRelated ) {
        $text .= "__%MAKETEXT{\"Related tags\"}%:__ "
               . join( ', ',
                       map{ _printTagLink( $_, $qBy ) }
                       grep{ !/^$qTag$/ }
                       sort keys( %related )
                     )
               . "\n\n";
    }

    my @topics = ();
    if( $sort eq 'tagcount' ) {
        # Sort topics by tag count
        @topics = sort{ $tagVotes{$b} <=> $tagVotes{$a} } keys( %tagVotes );
    } elsif( $sort eq 'topic' ) {
        # Sort topics by topic name
        @topics = sort{ substr($a, rindex($a, '.')) cmp substr($b, rindex($b, '.')) }
                  keys( %tagVotes );
    } else {
        # Sort topics by web, then topic
        @topics = sort keys( %tagVotes );
    }
    if( $format =~ /\$size/ ) {
        # handle formatting with $size (slower)
        my %order = ();
        my $max = 1;
        my $size = 0;
        %order = map{ ($_, $max++) }
                 sort{ $tagVotes{$a} <=> $tagVotes{$b} }
                 keys( %tagVotes );
        foreach $webTopic ( @topics ) {
            $size = int( $maxSize * ( $order{$webTopic} + 1 ) / $max );
            $size = $minSize if( $size < $minSize );
            $text .= _printWebTopic( $webTopic, $topicTags{$webTopic}, $qBy,
                                    $format, $tagVotes{$webTopic}, $size );
            $text .= $separator;
        }
    } else {
        # normal formatting without $size (faster)
        foreach $webTopic ( @topics ) {
            $text .= _printWebTopic( $webTopic, $topicTags{$webTopic}, $qBy,
                                    $format, $tagVotes{$webTopic} );
            $text .= $separator;
        }
    }
    $text =~ s/\Q$separator\E$//s;
    $text .= "\n%MAKETEXT{\"Number of topics\"}%: "
           . scalar( keys( %tagVotes ) ) unless( $noTotal );
    _handleMakeText( $text );
    return $text;
}

# =========================
Topic revision: r2 - 2008-03-02 - FredMorris
 
Twitter Delicious Facebook Digg Google Bookmarks E-mail LinkedIn Reddit StumbleUpon    
  • Download TWiki
TWiki logo Powered by Perl Hosted by OICcam.com Ideas, requests, problems regarding TWiki? Send feedback. Ask community in the support forum.
Copyright © 1999-2012 by the contributing authors. All material on this collaboration platform is the property of the contributing authors.