xfn.pl 1.5 KB

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