modules/tagmap.pl

   1 # Copyright (C) 2005  Fletcher T. Penney <fletcher@freeshell.org>
   2 # Copyright (c) 2007  Alexander Uvizhev <uvizhe@yandex.ru>
   3 #
   4 # This program is free software; you can redistribute it and/or modify
   5 # it under the terms of the GNU General Public License as published by
   6 # the Free Software Foundation; either version 2 of the License, or
   7 # (at your option) any later version.
   8 #
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License
  15 # along with this program; if not, write to the
  16 #    Free Software Foundation, Inc.
  17 #    59 Temple Place, Suite 330
  18 #    Boston, MA 02111-1307 USA
  19
  20 $ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git/tree/modules/tagmap.pl">tagmap.pl</a>, see <a href="http://www.oddmuse.org/cgi-bin/oddmuse/TagMap_Module">TagMap Module</a></p>';
  21
  22 use vars qw($TagMapPage $TagMark $TagClass $TagString $TagSearchTitle);
  23
  24 $TagMapPage = "TagMap" unless defined $TagMapPage;
  25
  26 # Page tags are identified by this mark (input mark)
  27 $TagMark = "Tags:" unless defined $TagMark;
  28
  29 # Page tags enclosed in DIV block of this class
  30 $TagClass = "tags" unless defined $TagClass;
  31
  32 # This string precedes tags on page (output mark)
  33 $TagString = "Tags: " unless defined $TagString;
  34
  35 $Action{tagmap} = \&DoTagMap;
  36
  37 $Action{tagsearch} = \&DoTagSearch;
  38
  39 $TagSearchTitle = "Pages with tag %s";
  40
  41 push (@MyRules, \&TagRule);
  42
  43 my %TagList = ();
  44 my $TagXML;
  45
  46 sub TagRule { # Process page tags on a page
  47
  48     if ( m/\G$TagMark\s*(.*)/gc) {  # find page tags
  49         my @tags = split /,\s*/, $1;  # push them in array
  50         @tags = map {                 # and generate html output:
  51             qq{<a href="$ScriptName?action=tagsearch;tag=$_">$_</a>};  # each tag is a link to search all pages with that tag
  52         } @tags;
  53         my $tags = join ', ', @tags;
  54         return qq{<div class="$TagClass">$TagString$tags</div>}; # tags are put in DIV block
  55     }
  56     return undef;
  57
  58 }
  59
  60 sub DoTagSearch {
  61
  62     my $searchedtag = GetParam('tag');  # get tag parameter
  63     my $header = Ts($TagSearchTitle, $searchedtag);  # modify page title with requested tag
  64     print GetHeader('',$header,'');  # print title
  65
  66     print '<div class="content">';
  67
  68     my $SearchResult = GenerateSearchResult($searchedtag);
  69
  70     print $SearchResult;
  71     print '</div>';
  72     PrintFooter();
  73
  74 }
  75
  76 sub GenerateSearchResult {
  77
  78     my $searchedtag = shift @_;
  79
  80     my @pages = AllPagesList();
  81
  82     local %Page;
  83     local $OpenPageName='';
  84
  85     my $SearchResult .= "<ul>";
  86
  87     foreach my $page (@pages) {
  88         OpenPage($page);                    # open a page
  89         my @tags = GetTags($Page{text});    # collect tags in an array
  90             foreach (@tags) {
  91                 if (/^$searchedtag$/) {
  92                     my $name = NormalToFree($page);
  93                     $SearchResult .= "<li><a href=\"$ScriptName/$page\">$name</a></li>";  # list of pages
  94             }
  95         }
  96     }
  97     $SearchResult .= "</ul>";
  98
  99     return $SearchResult;
 100
 101 }
 102
 103 sub DoTagMap {
 104
 105         print GetHeader('',$TagMapPage,'');
 106
 107         CreateTagMap();
 108
 109         print '<div class="content">';
 110
 111         PrintTagMap();
 112
 113         print '</div>';
 114
 115         PrintFooter();
 116 }
 117
 118
 119 sub CreateTagMap {
 120         my @pages = AllPagesList();
 121
 122         local %Page;
 123         local $OpenPageName='';
 124         $TagXML .= "<taglist>\n";
 125
 126         foreach my $page (@pages) {
 127                 OpenPage($page);
 128                 my @tags = GetTags($Page{text});
 129                 $page = FreeToNormal($page);
 130
 131                 my $count = @tags;
 132                 if ($count != 0) {
 133                         $TagXML .= "<object><id>$page</id>\n";
 134
 135                         foreach (@tags) {
 136                                 $TagXML .= "<tag>$_</tag>";
 137                                 $TagList{$_} = 1;
 138                         }
 139                         $TagXML .= "\n</object>\n";
 140                 }
 141         }
 142
 143         $TagXML .= "</taglist>\n";
 144
 145 }
 146
 147 sub PrintTagMap {
 148         do "$ModuleDir/TagCategorizer/TagCategorizer.pl";
 149
 150         my $result = TagCategorizer::ProcessXML($TagXML);
 151         $result =~ s/\<tagHierarchy\>/<ul>/;
 152         $result =~ s/\<\/tagHierarchy\>/<\/ul>/;
 153
 154         $result =~ s{
 155                 <tag[ ]title="(.*?)">
 156         }{
 157                 my $tag = $1;
 158
 159                 "<li>$tag</li>\n<ul>";
 160         }xsge;
 161
 162         $result =~ s/\<\/tag\>/<\/ul>/g;
 163         $result =~ s{
 164                 <object>(.*?)</object>
 165         }{
 166                 my $id = $1;
 167                 my $name = $id;
 168                 $name =~ s/_/ /g;
 169                 "<li><a href=\"$ScriptName\/$id\">$name</a></li>";
 170         }xsge;
 171         print $result;
 172 }
 173
 174 sub GetTags {
 175         my $text = shift;
 176         my @tags;
 177
 178         # strip [[.*?]] bits, then split on spaces
 179
 180         if ($text =~ /^$TagMark\s*(.*)$/m) {
 181                 my $tagstring = $1;
 182                 @tags = split /,\s*/, $tagstring;
 183         } else {
 184                 return;
 185         }
 186
 187         return @tags;
 188 }
 189
 190 *TagMapOldBrowseResolvedPage = *BrowseResolvedPage;
 191 *BrowseResolvedPage = *TagMapBrowseResolvedPage;
 192
 193 sub TagMapBrowseResolvedPage {
 194         my $title = shift;
 195         $title =~ s/_/ /g;
 196         my $id = FreeToNormal($title);
 197         if ($id eq $TagMapPage) {
 198                 DoTagMap();
 199         } else {
 200                 TagMapOldBrowseResolvedPage($id);
 201         }
 202 }
 203
 204 *TagMapOldPrintWikiToHTML = *PrintWikiToHTML;
 205 *PrintWikiToHTML = *TagMapPrintWikiToHTML;
 206
 207 sub TagMapPrintWikiToHTML {
 208         my ($pageText, $savecache, $revision, $islocked) = @_;
 209
 210         # Cause an empty page with the name $ClusterMapPage to
 211         # display a map.
 212         if (($TagMapPage eq $OpenPageName)
 213                 && ($pageText =~ /^\s*$/s)){
 214                 CreateTagMap();
 215                 PrintTagMap();
 216         }
 217         TagMapOldPrintWikiToHTML(@_);
 218 }