weblog-tracking.pl 2.9 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697
  1. # Copyright (C) 2004 Alex Schroeder <alex@emacswiki.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 2 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, write to the
  15. # Free Software Foundation, Inc.
  16. # 59 Temple Place, Suite 330
  17. # Boston, MA 02111-1307 USA
  18. # Weblog Tracker Notification Extension
  19. use strict;
  20. use v5.10;
  21. our ($q, $UsePathInfo, $ScriptName, $SiteName);
  22. our (%NotifyJournalPage, @NotifyUrlPatterns);
  23. AddModuleDescription('weblog-tracking.pl', 'Update Weblog Tracker Extension');
  24. # Put this file in your modules directory.
  25. %NotifyJournalPage = ();
  26. @NotifyUrlPatterns = ();
  27. # NotifyJournalPage maps page names matching a certain pattern to
  28. # another page. In the example given below, \d stands for any number.
  29. # Thus any page name matching a date such as 2004-01-23 will map to
  30. # the Diary page. You can add more statements like these right here.
  31. $NotifyJournalPage{'\d\d\d\d-\d\d-\d\d'}='Diary';
  32. # NotifyUrlPatterns is a list of URLs to visit. They may contain three variables:
  33. # 1. $name is replaced by the name of the page.
  34. # 2. $url is replaced by the URL to the page.
  35. # 3. $rss is replaced by the RSS feed for your site.
  36. # You can push more of these statements onto the list.
  37. push (@NotifyUrlPatterns, 'http://ping.blo.gs/?name=$name&url=$url&rssUrl=$rss&direct=1');
  38. # You should not need to change anything below this point.
  39. *OldWeblogTrackingSave = \&Save;
  40. *Save = \&NewWeblogTrackingSave;
  41. sub NewWeblogTrackingSave {
  42. my ($id, $new, $summary, $minor, $upload) = @_;
  43. OldWeblogTrackingSave(@_);
  44. if (not $minor) {
  45. PingTracker($id);
  46. }
  47. }
  48. sub PingTracker {
  49. my $id = shift;
  50. foreach my $regexp (keys %NotifyJournalPage) {
  51. if ($id =~ m/$regexp/) {
  52. $id = $NotifyJournalPage{$regexp};
  53. last;
  54. }
  55. }
  56. if ($q->url(-base=>1) !~ m|^http://localhost|) {
  57. my $url;
  58. if ($UsePathInfo) {
  59. $url = $ScriptName . '/' . $id;
  60. } else {
  61. $url = $ScriptName . '?' . $id;
  62. }
  63. $url = UrlEncode($url);
  64. my $name = UrlEncode($SiteName . ': ' . $id);
  65. my $rss = UrlEncode($q->url . '?action=rss');
  66. require LWP::UserAgent;
  67. foreach my $uri (@NotifyUrlPatterns) {
  68. my $fork = fork();
  69. if (not ($fork > 0)) { # either we're the child or forking failed
  70. $uri =~ s/\$name/$name/g;
  71. $uri =~ s/\$url/$url/g;
  72. $uri =~ s/\$rss/$rss/g;
  73. my $ua = LWP::UserAgent->new;
  74. my $request = HTTP::Request->new('GET', $uri);
  75. $ua->request($request);
  76. exit if ($fork == 0); # exit when we're the child
  77. }
  78. }
  79. }
  80. }