modules/xfn.pl

   1 #
   2 # A very simple module to support XHTML Friends Network (http://www.gmpg.org/xfn/)
   3 #
   4 # Copyright (C) 2006 Alex Schroeder <alex@emacswiki.org>
   5 # Copyright (C) 2006 Alexandre (adulau) Dulaunoy <adulauATATfoo.be>
   6 #
   7 # This program is free software; you can redistribute it and/or modify
   8 # it under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 2 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # This program is distributed in the hope that it will be useful,
  13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with this program; if not, write to the
  19 #    Free Software Foundation, Inc.
  20 #    59 Temple Place, Suite 330
  21 #    Boston, MA 02111-1307 USA
  22
  23 $ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git/tree/modules/xfn.pl">xfn.pl</a>, see <a href="http://www.oddmuse.org/cgi-bin/oddmuse/xfn_Module">xfn Module</a></p>';
  24
  25 push ( @MyRules, \&xfnRule );
  26
  27 my $PersonPattern = '\[\[person:(.*?)\]\]';
  28
  29 *MyOldGetHtmlHeader = *GetHtmlHeader;
  30 *GetHtmlHeader      = *MyNewGetHtmlHeader;
  31
  32 sub MyNewGetHtmlHeader {
  33     my $result = MyOldGetHtmlHeader(@_);
  34     $result =~ s/\<head\>/\<head profile=\"http:\/\/gmpg.org\/xfn\/11\"\>/;
  35     return $result;
  36 }
  37
  38 sub xfnRule {
  39     if (m/\G$PersonPattern/cog) { return &Person($1); }
  40
  41     return undef;
  42 }
  43
  44 sub Person {
  45     my $xfn = shift;
  46     my ( $url, $text, $rel ) = split ( /\|/, $xfn );
  47     return $q->a( { -href => "${url}", -rel => "${rel}" }, "$text" );
  48 }
  49