xfn.pl 1.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051
  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 3 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, see <http://www.gnu.org/licenses/>.
  19. use strict;
  20. use v5.10;
  21. AddModuleDescription('xfn.pl', 'xfn Module');
  22. our ($q, @MyRules);
  23. push ( @MyRules, \&xfnRule );
  24. my $PersonPattern = '\[\[person:(.*?)\]\]';
  25. *MyOldGetHtmlHeader = \&GetHtmlHeader;
  26. *GetHtmlHeader = \&MyNewGetHtmlHeader;
  27. sub MyNewGetHtmlHeader {
  28. my $result = MyOldGetHtmlHeader(@_);
  29. $result =~ s/\<head\>/\<head profile=\"http:\/\/gmpg.org\/xfn\/11\"\>/;
  30. return $result;
  31. }
  32. sub xfnRule {
  33. if (m/\G$PersonPattern/cg) { return &Person($1); }
  34. return;
  35. }
  36. sub Person {
  37. my $xfn = shift;
  38. my ( $url, $text, $rel ) = split ( /\|/, $xfn );
  39. return $q->a( { -href => "${url}", -rel => "${rel}" }, "$text" );
  40. }