org-permanent-anchors.pl

   1 # Copyright (C) 2003, 2004, 2005, 2006, 2007  Alex Schroeder <alex@gnu.org>
   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 3 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, see <http://www.gnu.org/licenses/>.
  15
  16 $ModulesDescription .= '<p>See <a href="http://oddmuse.org/wiki/Org_Markup_Extension">Org Markup Extension</a></p>';
  17
  18 =head1 Permanent Anchors
  19
  20 This module allows you to create link targets within a page. These
  21 link targets are called named anchors in HTML. The anchors provided by
  22 this module are permanent, because moving the anchor from one page to
  23 another does not affect the links pointing to it. You link to these
  24 named anchors as if they were pagenames. For users, it makes no
  25 difference.
  26
  27 =cut
  28
  29 use vars qw(%PermanentAnchors %PagePermanentAnchors $PermanentAnchorsFile);
  30
  31 $PermanentAnchorsFile = "$DataDir/permanentanchors";
  32
  33 =head2 Definition
  34
  35 Permanent anchors are defined by using square brackets and a double
  36 colon, like this: C<[::Example]>.
  37
  38 If you define a permanent anchor that already exists, the new
  39 definition will have no effect. Instead you will be shown a link to
  40 the existing permanent anchor so that you can easily resolve the
  41 conflict.
  42
  43 If you define a permanent anchor and a page of the same name already
  44 exists, the definition will work, and all links will point to the
  45 permanent anchor. You will also be given a link to the existing page
  46 so that you can easily resolve the conflict (eg. by deleting the
  47 page). Note that if you mark the page for deletion, you will still
  48 have to wait for page expiry to kick in and actually delete the page
  49 before the message disappears.
  50
  51 During anchor definition a lock is created in the temporary directory.
  52 If Oddmuse encounters a lock while defining a permanent anchor, it
  53 will wait a few seconds and try again. If the lock cannot be obtained,
  54 the definition fails. The unlock action available from the
  55 administration page allows you to remove any stale locks once you're
  56 sure the locks have been left behind by a crash. After having removed
  57 the stale lock, edit the page with the permanent anchor definition
  58 again.
  59
  60 When linking to a permanent anchor on the same page, you'll notice
  61 that this only works flawlessly if the definition comes first. When
  62 rendering a page, permanent anchor definitions and links are parsed in
  63 order. Thus, if the link comes first, the permanent anchor definition
  64 is not yet available. Once you invalidate the HTML cache (by editing
  65 another page or by removing the C<pageidx> file from the data
  66 directory), this situation will have fixed itself.
  67
  68 =cut
  69
  70 push(@MyRules, \&PermanentAnchorsRule);
  71
  72 # OrgRule strips DRAWERs.  In order that PermanentAnchorsRule get a
  73 # chance to process CUSTOM_ID, it must be run before OrgRule.
  74 $RuleOrder{\&PermanentAnchorsRule} = 125;
  75
  76 sub PermanentAnchorsRule {
  77   my ($locallinks, $withanchors) = @_;
  78   if ($bol && m/\G((\s*\n)*[ \t]*:[^\n]+?:[ \t]*(\n.+?)??\n[ \t]*:CUSTOM_ID:[ \t]*(.+?)[ \t]*(\n.+?)??\n[ \t]*:END:[ \t]*(\n|$))/cogsi) {
  79     #[::Free Link] permanent anchor create only $withanchors
  80     Dirty($1);
  81     if ($withanchors) {
  82       print GetPermanentAnchor($4);
  83     } else {
  84       print $q->span({-class=>'permanentanchor'}, $4);
  85     }
  86   }
  87   return undef;
  88 }
  89
  90 sub GetPermanentAnchor {
  91   my $id = FreeToNormal(shift);
  92   my $text = NormalToFree($id);
  93   my ($class, $resolved, $title, $exists) = ResolveId($id);
  94   if ($class eq 'alias' and $title ne $OpenPageName) {
  95     return '[' . Ts('anchor first defined here: %s',
  96                     ScriptLink(UrlEncode($resolved), $text, 'alias')) . ']';
  97   } elsif ($PermanentAnchors{$id} ne $OpenPageName
  98            # 10 tries, 3 second wait, die on error
  99            and RequestLockDir('permanentanchors', 10, 3, 1)) {
 100     # Somebody may have added a permanent anchor in the mean time.
 101     # Comparing $LastUpdate to the $IndexFile mtime does not work for
 102     # subsecond changes and updates are rare, so just reread the file!
 103     PermanentAnchorsInit();
 104     $PermanentAnchors{$id} = $OpenPageName;
 105     WritePermanentAnchors();
 106     ReleaseLockDir('permanentanchors');
 107   }
 108   $PagePermanentAnchors{$id} = 1; # add to the list of anchors in page
 109   my $html = GetSearchLink($id, 'definition', $id,
 110     T('Click to search for references to this permanent anchor'));
 111   $html .= ' [' . Ts('the page %s also exists',
 112                      ScriptLink("action=browse;anchor=0;id="
 113                                 . UrlEncode($id), NormalToFree($id), 'local'))
 114     . ']' if $exists;
 115   return $html;
 116 }
 117
 118 =head2 Storage
 119
 120 Permanent anchor definitions need to be stored in a separate file.
 121 Otherwise linking to a permanent anchor would require a search of the
 122 entire page database. The permanent anchors are stored in a file
 123 called C<permanentanchors> in the data directory. The location can be
 124 changed by setting C<$PermanentAnchorsFile>.
 125
 126 The format of the file is simple: permanent anchor names and the name
 127 of the page they are defined on follow each other, separated by
 128 whitespace. Spaces within permanent anchor names and page names are
 129 replaced with underlines, as always. Thus, the keys of
 130 C<%PermanentAnchors> is the name of the permanent anchor, and
 131 C<$PermanentAnchors{$name}> is the name of the page it is defined on.
 132
 133 =cut
 134
 135 push(@MyInitVariables, \&PermanentAnchorsInit);
 136
 137 sub PermanentAnchorsInit {
 138   %PagePermanentAnchors = %PermanentAnchors = ();
 139   my ($status, $data) = ReadFile($PermanentAnchorsFile);
 140   return unless $status; # not fatal
 141   # $FS was used in 1.417 and earlier!
 142   %PermanentAnchors = split(/\n| |$FS/,$data);
 143 }
 144
 145 sub WritePermanentAnchors {
 146   my $data = '';
 147   foreach my $name (keys %PermanentAnchors) {
 148     $data .= $name . ' ' . $PermanentAnchors{$name} ."\n";
 149   }
 150   WriteStringToFile($PermanentAnchorsFile, $data);
 151 }
 152
 153 =head2 Deleting Anchors
 154
 155 When deleting a page Oddmuse needs to delete the corresponding
 156 permanent anchors from its file. This is why the
 157 C<DeletePermanentAnchors> function is called from C<DeletePage>.
 158
 159 When a page is edited, we want to make sure that Oddmuse deletes the
 160 permanent anchors no longer needed from its file. The safest way to do
 161 this is to delete all permanent anchors defined on the page being
 162 edited and redefine them when it is rendered for the first time. This
 163 is achieved by calling C<DeletePermanentAnchors> from C<Save>. After
 164 hitting the save button, the user is automatically redirected to the
 165 new page. This will render the page, and redefine all permanent
 166 anchors.
 167
 168 =cut
 169
 170 *OldPermanentAnchorsDeletePage = *DeletePage;
 171 *DeletePage = *NewPermanentAnchorsDeletePage;
 172
 173 sub NewPermanentAnchorsDeletePage {
 174   OldPermanentAnchorsDeletePage(@_);
 175   DeletePermanentAnchors(@_); # the only parameter is $id
 176 }
 177
 178 *OldPermanentAnchorsSave = *Save;
 179 *Save = *NewPermanentAnchorsSave;
 180
 181 sub NewPermanentAnchorsSave {
 182   OldPermanentAnchorsSave(@_);
 183   DeletePermanentAnchors(@_); # the first parameter is $id
 184 }
 185
 186 sub DeletePermanentAnchors {
 187   my $id = shift;
 188   # 10 tries, 3 second wait, die on error
 189   RequestLockDir('permanentanchors', 10, 3, 1);
 190   foreach (keys %PermanentAnchors) {
 191     if ($PermanentAnchors{$_} eq $id and !$PagePermanentAnchors{$_}) {
 192       delete($PermanentAnchors{$_}) ;
 193     }
 194   }
 195   WritePermanentAnchors();
 196   ReleaseLockDir('permanentanchors');
 197 }
 198
 199 =head2 Name Resolution
 200
 201 Name resolution is done by C<ResolveId>. This function returns a list
 202 of several items: The CSS class to use, the resolved id, the title
 203 (eg. for popups), and a boolean saying whether the page actually
 204 exists or not. When resolving a permanent anchor, the CSS class used
 205 will be “alias”, the resolved id will be the C<pagename#anchorname>,
 206 the title will be the page name.
 207
 208 You can override this behaviour by providing the parameter
 209 C<anchor=0>. This is used for the link in the warning message “the
 210 page foo also exists.”
 211
 212 =cut
 213
 214 *OldPermanentAnchorsResolveId = *ResolveId;
 215 *ResolveId = *NewPermanentAnchorsResolveId;
 216
 217 sub NewPermanentAnchorsResolveId {
 218   my $id = shift;
 219   my $page = $PermanentAnchors{$id};
 220   if (GetParam('anchor', 1) and $page and $page ne $id) {
 221     return ('alias', $page . '#' . $id, $page, $IndexHash{$id})
 222   } else {
 223     return OldPermanentAnchorsResolveId($id, @_);
 224   }
 225 }
 226
 227 =head2 Anchor Objects
 228
 229 An anchor object is the text that starts after the anchor definition
 230 and goes up to the next heading, horizontal line, or the end of the
 231 page. By redefining C<GetPageContent> to work on anchor objects we
 232 automatically allow internal transclusion.
 233
 234 =cut
 235
 236 *OldPermanentAnchorsGetPageContent = *GetPageContent;
 237 *GetPageContent = *NewPermanentAnchorsGetPageContent;
 238
 239 sub NewPermanentAnchorsGetPageContent {
 240   my $id = shift;
 241   my $result = OldPermanentAnchorsGetPageContent($id);
 242   if (not $result and $PermanentAnchors{$id}) {
 243     $result = OldPermanentAnchorsGetPageContent($PermanentAnchors{$id});
 244     $result =~ s/^(.*\n)*.*\[::$id\]// or return '';
 245     $result =~ s/(\n=|\n----|\[::$FreeLinkPattern\])(.*\n)*.*$//o;
 246   }
 247   return $result;
 248 }
 249
 250 =head2 User Interface Changes
 251
 252 Some user interface changes are required as well.
 253
 254 =over
 255
 256 =item *
 257
 258 Allow the page index to list permanent anchors or not by setting
 259 C<@IndexOptions>.
 260
 261 =cut
 262
 263 push(@IndexOptions, ['permanentanchors', T('Include permanent anchors'),
 264                      1, sub { keys %PermanentAnchors }]);
 265
 266 =item *
 267
 268 Make sure that you can view old revisions of pages that have a
 269 permanent anchor of the same name. This requires link munging for all
 270 browse links from C<GetHistoryLine>.
 271
 272 =back
 273
 274 =cut
 275
 276 *OldPermanentAnchorsGetHistoryLine = *GetHistoryLine;
 277 *GetHistoryLine = *NewPermanentAnchorsGetHistoryLine;
 278
 279 sub NewPermanentAnchorsGetHistoryLine {
 280   my $id = shift;
 281   my $html = OldPermanentAnchorsGetHistoryLine($id, @_);
 282   if ($PermanentAnchors{$id}) {
 283     my $encoded_id = UrlEncode($id);
 284     # link to the current revision; ignore dependence on $UsePathInfo
 285     $html =~ s!$ScriptName[/?]$encoded_id!$ScriptName?action=browse;anchor=0;id=$encoded_id!;
 286     # link to old revisions
 287     $html =~ s!action=browse;id=$encoded_id!action=browse;anchor=0;id=$encoded_id!g;
 288   }
 289   return $html;
 290 }