vcard.pl 2.1 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465
  1. # Copyright (C) 2011–2015 Alex Schroeder <alex@gnu.org>
  2. # Copyright (C) 2014–2015 Aleks-Daniel Jakimenko <alex.jakimenko@gmail.com>
  3. #
  4. # This program is free software; you can redistribute it and/or modify it under
  5. # the terms of the GNU General Public License as published by the Free Software
  6. # Foundation; either version 3 of the License, or (at your option) any later
  7. # version.
  8. #
  9. # This program is distributed in the hope that it will be useful, but WITHOUT
  10. # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  11. # FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
  12. #
  13. # You should have received a copy of the GNU General Public License along with
  14. # this program. If not, see <http://www.gnu.org/licenses/>.
  15. #
  16. # We just try to autodetect everything.
  17. use strict;
  18. use v5.10;
  19. AddModuleDescription('vcard.pl');
  20. our ($q, $bol, @MyRules);
  21. push(@MyRules, \&hCardRule);
  22. my $addr = qr(\G(\S+ \S+)
  23. (.*)
  24. ((?:[A-Z][A-Z]?-)?\d+) (.*)(?:
  25. (.*))?
  26. );
  27. my $email = qr(\G\s*(\S+@\S+)\n?);
  28. my $tel = qr(\G\s*(\S+): (\+?[-0-9 ]+)\n?);
  29. sub hCardRule {
  30. return unless $bol;
  31. my ($fn, $street, $zip, $city, $country) = /$addr/cg;
  32. if ($fn) {
  33. my ($mail) = /$email/cg;
  34. my ($phonetype, $phone) = /$tel/cg;
  35. my $html = $q->span({-class=>'fn'}, $fn) . $q->br();
  36. $html .= $q->span({-class=>'street-address'}, $street) . $q->br();
  37. $html .= $q->span({-class=>'postal-code'}, $zip)
  38. . ' ' . $q->span({-class=>'locality'}, $city);
  39. $html .= $q->br()
  40. . $q->span({-class=>'country-name'}, $country) if $country;
  41. my $hCard = $q->p($html);
  42. $html = '';
  43. $html .= $q->span({-class=>'email'},
  44. $q->a({-href=>'mailto:' . $mail}, $mail)) if $mail;
  45. $html .= $q->br() if $mail and $phone;
  46. $html .= $q->span({-class=>'tel'},
  47. $q->span({-class=>'type'}, $phonetype) . ': '
  48. . $q->span({-class=>'value'}, $phone)) if $phone;
  49. $hCard .= $q->p($html) if $html;
  50. $hCard = $q->div({-class=>'vcard',
  51. -style=>'color:red;'}, $hCard);
  52. return CloseHtmlEnvironments() . $hCard . AddHtmlEnvironment('p');
  53. }
  54. return;
  55. }