linktagmap.pl 8.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256
  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. use strict;
  22. use v5.10;
  23. AddModuleDescription('linktagmap.pl', 'LinkTagMap Module');
  24. our (%Action, %Page, $OpenPageName, $ModuleDir, @MyRules, $ScriptName);
  25. our ($LinkTagMark, $LinkDescMark, $LinkTagClass, $LinkDescClass, $LinkTagMapPage, $UrlPattern, $FullUrlPattern, $LinkTagSearchTitle);
  26. # Tags and descripton are embraced with this sequences
  27. $LinkTagMark = '%T%' unless defined $LinkTagMark;
  28. $LinkDescMark = '%D%' unless defined $LinkDescMark;
  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. # Wiki page, where links will be present in a structured way
  33. $LinkTagMapPage = "LinkTagMap" unless defined $LinkTagMapPage;
  34. # The same output with wiki.pl?action=linktagmap
  35. $Action{linktagmap} = \&DoLinkTagMap;
  36. # Action to search and show all links with specified tag
  37. $Action{linktagsearch} = \&DoLinkTagSearch;
  38. # Header of a search result
  39. $LinkTagSearchTitle = "Links with tag %s";
  40. my $rstr = crypt($$,$$);
  41. push (@MyRules, \&LinkTagRule, \&LinkDescriptionRule);
  42. sub LinkTagRule { # Process link tags on a page
  43. if ( m/\G$LinkTagMark(.*?)$LinkTagMark/cg) { # find tags
  44. my @linktags = split /,\s*/, $1; # push them in array
  45. @linktags = map { # and generate html output:
  46. qq{<a href="$ScriptName?action=linktagsearch;linktag=$_">$_</a>}; # each tag is a link to search all links with that tag
  47. } @linktags;
  48. my $linktags = join ', ', @linktags;
  49. return qq{<span class="$LinkTagClass">$linktags</span>}; # tags are put in SPAN block
  50. }
  51. return;
  52. }
  53. sub LinkDescriptionRule { # Process link descriptions on a page
  54. if ( m/\G$LinkDescMark(.*?)$LinkDescMark/cg) { # find description
  55. return qq{<span class="$LinkDescClass">$1</span>}; # put it in SPAN block
  56. }
  57. return;
  58. }
  59. sub DoLinkTagMap {
  60. print GetHeader('',$LinkTagMapPage,'');
  61. my $TagXML = GenerateLinkTagMap();
  62. print '<div class="content">';
  63. PrintLinkTagMap($TagXML);
  64. print '</div>';
  65. PrintFooter();
  66. }
  67. sub DoLinkTagSearch {
  68. my $searchedtag = GetParam('linktag'); # get tag parameter
  69. my $header = Ts($LinkTagSearchTitle, $searchedtag); # modify page title with requested tag
  70. print GetHeader('',$header,''); # print title
  71. print '<div class="content">';
  72. my $SearchResult = GenerateLinkSearchResult($searchedtag);
  73. print $SearchResult;
  74. print '</div>';
  75. PrintFooter();
  76. }
  77. sub GenerateLinkSearchResult {
  78. my $searchedtag = shift @_;
  79. my @pages = AllPagesList();
  80. local %Page;
  81. local $OpenPageName='';
  82. my $SearchResult .= "<ul>";
  83. foreach my $page (@pages) {
  84. OpenPage($page); # open a page
  85. my @links = GetLinks($Page{text}); # find links
  86. foreach my $link (@links) {
  87. my @tags = GetLinkTags($link->{tags}); # collect tags in an array
  88. foreach (@tags) {
  89. if (/^$searchedtag$/) {
  90. my @linktags = split /,\s*/, $link->{tags}; # push tags in an array
  91. @linktags = map { # and print html output:
  92. qq{<a href="$ScriptName?action=linktagsearch;linktag=$_">$_</a>}; # each tag is a link to search all links with that tag
  93. } @linktags;
  94. my $linktags = join ', ', @linktags;
  95. if ( length $link->{name} == 0 ) { $link->{name} = $link->{url}; } # if link has no name we use url instead
  96. $SearchResult .= "<li><a href=\"$link->{url}\">$link->{name}</a><span class=\"$LinkTagClass\">$linktags</span><span class=\"$LinkDescClass\">$link->{description}</span></li>";
  97. }
  98. }
  99. }
  100. }
  101. $SearchResult .= "</ul>";
  102. return $SearchResult;
  103. }
  104. sub GenerateLinkTagMap { # Generate an input XML for TagCategorizer
  105. my @pages = AllPagesList();
  106. local %Page;
  107. local $OpenPageName='';
  108. my $TagXML .= "<taglist>\n";
  109. foreach my $page (@pages) {
  110. OpenPage($page); # open a page
  111. my @links = GetLinks($Page{text}); # find links
  112. foreach my $link (@links) {
  113. my @tags = GetLinkTags($link->{tags}); # collect tags in an array
  114. $TagXML .= "<object><id>$link->{url}\|$rstr\|$link->{name}\|$rstr\|$link->{description}</id>\n"; # put everything in 'id' block
  115. foreach (@tags) { # except of tags
  116. $TagXML .= "<tag>$_</tag>"; # which are in 'tag' blocks
  117. }
  118. $TagXML .= "\n</object>\n";
  119. }
  120. }
  121. $TagXML .= "</taglist>\n";
  122. return $TagXML;
  123. }
  124. sub PrintLinkTagMap {
  125. my $TagXML = shift @_;
  126. do "$ModuleDir/TagCategorizer/TagCategorizer.pl";
  127. my $result = TagCategorizer::ProcessXML($TagXML); # get an output XML from TagCategorizer
  128. $result =~ s/\<tagHierarchy\>/<ul>/; # and convert it to html
  129. $result =~ s/\<\/tagHierarchy\>/<\/ul>/;
  130. $result =~ s{
  131. <tag[ ]title="(.*?)">
  132. }{
  133. my $tag = $1;
  134. "<li id=\"$tag\">$tag</li>\n<ul>";
  135. }egsx;
  136. $result =~ s/\<\/tag\>/<\/ul>/g;
  137. $result =~ s{
  138. <object>$FullUrlPattern\|$rstr\|(.*?)\|$rstr\|(.*?)</object> # divide 'object' block content
  139. }{
  140. my $url = $1; # to url,
  141. my $name = $2; if ( length $name == 0 ) { $name = $url; } # name (if not present use url instead)
  142. my $description = $3; # and description
  143. "<li><a href=\"$url\">$name</a> <span class=\"$LinkDescClass\">$description</span></li>";
  144. }egsx;
  145. print $result;
  146. }
  147. sub GetLinks { # Search a page for links
  148. my $text = shift;
  149. my $text1 = $text;
  150. my @links;
  151. while ( $text =~ /($UrlPattern)\s*($LinkTagMark(.+?)$LinkTagMark\s*($LinkDescMark(.+?)$LinkDescMark)?)/cg # simple link
  152. or $text1 =~ /\[+$FullUrlPattern(.*?)\]+\s*($LinkTagMark(.+?)$LinkTagMark\s*($LinkDescMark(.+?)$LinkDescMark)?)/cg) { # link in brackets
  153. push @links, { url => $1, name => $2, tags => $4, description => $6 }; # push found links' attributes to an array of hashes
  154. }
  155. return @links;
  156. }
  157. sub GetLinkTags { # Retrieve tags (if present) from a link
  158. my $tags = shift;
  159. my @tags;
  160. @tags = split /\s*,\s*/, $tags;
  161. return @tags;
  162. }
  163. *LinkTagMapOldBrowseResolvedPage = \&BrowseResolvedPage;
  164. *BrowseResolvedPage = \&LinkTagMapBrowseResolvedPage;
  165. sub LinkTagMapBrowseResolvedPage {
  166. my $title = shift;
  167. $title =~ s/_/ /g;
  168. my $id = FreeToNormal($title);
  169. if ($id eq $LinkTagMapPage) {
  170. DoLinkTagMap();
  171. } else {
  172. LinkTagMapOldBrowseResolvedPage($id);
  173. }
  174. }
  175. *LinkTagMapOldPrintWikiToHTML = \&PrintWikiToHTML;
  176. *PrintWikiToHTML = \&LinkTagMapPrintWikiToHTML;
  177. sub LinkTagMapPrintWikiToHTML {
  178. my ($pageText) = @_;
  179. # Cause an empty page with the name $LinkTagMapPage to
  180. # display a map.
  181. if (($LinkTagMapPage eq $OpenPageName)
  182. && ($pageText =~ /^\s*$/s)){
  183. CreateLinkTagMap();
  184. PrintLinkTagMap();
  185. }
  186. LinkTagMapOldPrintWikiToHTML(@_);
  187. }