modules/linktagmap.pl

   1 # Copyright (C) 2007 Alexander Uvizhev <uvizhe@yandex.ru>
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2 of the License, or
   6 # (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program; if not, write to the
  15 #    Free Software Foundation, Inc.
  16 #    59 Temple Place, Suite 330
  17 #    Boston, MA 02111-1307 USA
  18 #
  19 # Based on code of tagmap.pl module by Fletcher T. Penney
  20 # and searchtags.pl module by Brock Wilcox
  21 $ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git/tree/modules/linktagmap.pl">linktagmap.pl</a>, see <a href="http://www.oddmuse.org/cgi-bin/oddmuse/LinkTagMap_Module">LinkTagMap Module</a></p>';
  22
  23 use vars qw($LinkTagMark $LinkDescMark $LinkTagClass $LinkDescClass $LinkTagMapPage $UrlPattern $FullUrlPattern $LinkTagSearchTitle);
  24
  25 # Tags and descripton are embraced with this sequences
  26 $LinkTagMark = '%T%' unless defined $LinkTagMark;
  27 $LinkDescMark = '%D%' unless defined $LinkDescMark;
  28
  29 # In output html these will be values for property "class" of SPAN tag
  30 $LinkTagClass = "lntag" unless defined $LinkTagClass;
  31 $LinkDescClass = "lndesc" unless defined $LinkDescClass;
  32
  33 # Wiki page, where links will be present in a structured way
  34 $LinkTagMapPage = "LinkTagMap" unless defined $LinkTagMapPage;
  35
  36 # The same output with wiki.pl?action=linktagmap
  37 $Action{linktagmap} = \&DoLinkTagMap;
  38
  39 # Action to search and show all links with specified tag
  40 $Action{linktagsearch} = \&DoLinkTagSearch;
  41
  42 # Header of a search result
  43 $LinkTagSearchTitle = "Links with tag %s";
  44
  45 my $rstr = crypt($$,$$);
  46
  47 push (@MyRules, \&LinkTagRule, \&LinkDescriptionRule);
  48
  49 sub LinkTagRule { # Process link tags on a page
  50
  51     if ( m/\G$LinkTagMark(.*?)$LinkTagMark/gc) {      # find tags
  52         my @linktags = split /,\s*/, $1;              # push them in array
  53         @linktags = map {                             # and generate html output:
  54             qq{<a href="$ScriptName?action=linktagsearch;linktag=$_">$_</a>};  # each tag is a link to search all links with that tag
  55         } @linktags;
  56         my $linktags = join ', ', @linktags;
  57         return qq{<span class="$LinkTagClass">$linktags</span>}; # tags are put in SPAN block
  58     }
  59     return undef;
  60
  61 }
  62
  63 sub LinkDescriptionRule { # Process link descriptions on a page
  64
  65     if ( m/\G$LinkDescMark(.*?)$LinkDescMark/gc) {          # find description
  66         return qq{<span class="$LinkDescClass">$1</span>};  # put it in SPAN block
  67     }
  68     return undef;
  69
  70 }
  71
  72 sub DoLinkTagMap {
  73
  74     print GetHeader('',$LinkTagMapPage,'');
  75
  76     my $TagXML = GenerateLinkTagMap();
  77
  78     print '<div class="content">';
  79
  80     PrintLinkTagMap($TagXML);
  81
  82     print '</div>';
  83
  84     PrintFooter();
  85
  86 }
  87
  88 sub DoLinkTagSearch {
  89
  90     my $searchedtag = GetParam('linktag');  # get tag parameter
  91     my $header = Ts($LinkTagSearchTitle, $searchedtag);  # modify page title with requested tag
  92     print GetHeader('',$header,'');  # print title
  93
  94     print '<div class="content">';
  95
  96     my $SearchResult = GenerateLinkSearchResult($searchedtag);
  97
  98     print $SearchResult;
  99     print '</div>';
 100     PrintFooter();
 101
 102 }
 103
 104 sub GenerateLinkSearchResult {
 105
 106     my $searchedtag = shift @_;
 107
 108     my @pages = AllPagesList();
 109
 110     local %Page;
 111     local $OpenPageName='';
 112
 113     my $SearchResult .= "<ul>";
 114
 115     foreach my $page (@pages) {
 116         OpenPage($page);                    # open a page
 117         my @links = GetLinks($Page{text});  # find links
 118         foreach my $link (@links) {
 119             my @tags = GetLinkTags($link->{tags});  # collect tags in an array
 120             foreach (@tags) {
 121                 if (/^$searchedtag$/) {
 122                     my @linktags = split /,\s*/, $link->{tags};   # push tags in an array
 123                     @linktags = map {                             # and print html output:
 124                         qq{<a href="$ScriptName?action=linktagsearch;linktag=$_">$_</a>};  # each tag is a link to search all links with that tag
 125                     } @linktags;
 126                     my $linktags = join ', ', @linktags;
 127                     if ( length $link->{name} == 0 ) { $link->{name} = $link->{url}; }  # if link has no name we use url instead
 128                     $SearchResult .= "<li><a href=\"$link->{url}\">$link->{name}</a><span class=\"$LinkTagClass\">$linktags</span><span class=\"$LinkDescClass\">$link->{description}</span></li>";
 129                 }
 130             }
 131         }
 132     }
 133     $SearchResult .= "</ul>";
 134
 135     return $SearchResult;
 136
 137 }
 138
 139 sub GenerateLinkTagMap { # Generate an input XML for TagCategorizer
 140
 141     my @pages = AllPagesList();
 142
 143     local %Page;
 144     local $OpenPageName='';
 145
 146     my $TagXML .= "<taglist>\n";
 147
 148     foreach my $page (@pages) {
 149         OpenPage($page);                    # open a page
 150         my @links = GetLinks($Page{text});  # find links
 151         foreach my $link (@links) {
 152             my @tags = GetLinkTags($link->{tags});  # collect tags in an array
 153             $TagXML .= "<object><id>$link->{url}\|$rstr\|$link->{name}\|$rstr\|$link->{description}</id>\n";  # put everything in 'id' block
 154             foreach (@tags) {                                                                                 # except of tags
 155                 $TagXML .= "<tag>$_</tag>";                                                                   # which are in 'tag' blocks
 156             }
 157             $TagXML .= "\n</object>\n";
 158         }
 159     }
 160     $TagXML .= "</taglist>\n";
 161
 162     return $TagXML;
 163
 164 }
 165
 166 sub PrintLinkTagMap {
 167
 168     my $TagXML = shift @_;
 169
 170     do "$ModuleDir/TagCategorizer/TagCategorizer.pl";
 171
 172     my $result = TagCategorizer::ProcessXML($TagXML);  # get an output XML from TagCategorizer
 173
 174     $result =~ s/\<tagHierarchy\>/<ul>/;               # and convert it to html
 175     $result =~ s/\<\/tagHierarchy\>/<\/ul>/;
 176
 177     $result =~ s{
 178         <tag[ ]title="(.*?)">
 179     }{
 180         my $tag = $1;
 181
 182         "<li id=\"$tag\">$tag</li>\n<ul>";
 183     }xsge;
 184
 185     $result =~ s/\<\/tag\>/<\/ul>/g;
 186     $result =~ s{
 187         <object>$FullUrlPattern\|$rstr\|(.*?)\|$rstr\|(.*?)</object>  # divide 'object' block content
 188     }{
 189         my $url = $1;                                               # to url,
 190         my $name = $2; if ( length $name == 0 ) { $name = $url; }   # name (if not present use url instead)
 191         my $description = $3;                                       # and description
 192         "<li><a href=\"$url\">$name</a> <span class=\"$LinkDescClass\">$description</span></li>";
 193     }xsge;
 194     print $result;
 195
 196 }
 197
 198 sub GetLinks { # Search a page for links
 199
 200     my $text = shift;
 201     my $text1 = $text;
 202     my @links;
 203     while ( $text =~ /($UrlPattern)\s*($LinkTagMark(.+?)$LinkTagMark\s*($LinkDescMark(.+?)$LinkDescMark)?)/cg  # simple link
 204         or $text1 =~ /\[+$FullUrlPattern(.*?)\]+\s*($LinkTagMark(.+?)$LinkTagMark\s*($LinkDescMark(.+?)$LinkDescMark)?)/cg) {  # link in brackets
 205         push @links, { url => $1, name => $2, tags => $4, description => $6 };  # push found links' attributes to an array of hashes
 206     }
 207     return @links;
 208
 209 }
 210 sub GetLinkTags { # Retrieve tags (if present) from a link
 211
 212     my $tags = shift;
 213     my @tags;
 214     @tags = split /\s*,\s*/, $tags;
 215     return @tags;
 216
 217 }
 218
 219 *LinkTagMapOldBrowseResolvedPage = *BrowseResolvedPage;
 220 *BrowseResolvedPage = *LinkTagMapBrowseResolvedPage;
 221
 222 sub LinkTagMapBrowseResolvedPage {
 223
 224     my $title = shift;
 225     $title =~ s/_/ /g;
 226     my $id = FreeToNormal($title);
 227     if ($id eq $LinkTagMapPage) {
 228         DoLinkTagMap();
 229     } else {
 230         LinkTagMapOldBrowseResolvedPage($id);
 231     }
 232
 233 }
 234
 235 *LinkTagMapOldPrintWikiToHTML = *PrintWikiToHTML;
 236 *PrintWikiToHTML = *LinkTagMapPrintWikiToHTML;
 237
 238 sub LinkTagMapPrintWikiToHTML {
 239
 240     my ($pageText) = @_;
 241
 242     # Cause an empty page with the name $LinkTagMapPage to
 243     # display a map.
 244     if (($LinkTagMapPage eq $OpenPageName)
 245         && ($pageText =~ /^\s*$/s)){
 246         CreateLinkTagMap();
 247         PrintLinkTagMap();
 248     }
 249     LinkTagMapOldPrintWikiToHTML(@_);
 250
 251 }