sync.pl 2.3 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576
  1. # Copyright (C) 2005, 2006 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. use strict;
  19. use v5.10;
  20. AddModuleDescription('sync.pl', 'Page Synchronization');
  21. our ($q, %Page, $OpenPageName, @MyRules, $FullUrl, $FullUrlPattern, $ScriptName);
  22. push(@MyRules, \&SyncRule);
  23. sub SyncRule {
  24. # [[copy:http://example.com/wiki]]
  25. if (m/\G\[\[(copy:$FullUrlPattern)\]\]/cg) {
  26. my ($text, $url) = ($1, $2);
  27. return $q->a({-href=>$2, class=>'outside copy'}, $text);
  28. }
  29. return;
  30. }
  31. *SyncOldSave = \&Save;
  32. *Save = \&SyncNewSave;
  33. sub SyncNewSave {
  34. my ($id) = @_;
  35. SyncOldSave(@_);
  36. # %Page is now set, but the reply was not yet sent back to the
  37. # browser
  38. $id = $OpenPageName; # TODO masks earlier declaration
  39. my $data = $Page{text};
  40. my $user = $Page{username};
  41. my $summary = $Page{summary};
  42. my $minor = $Page{minor};
  43. my @links = ();
  44. while ($data =~ m/\[\[copy:$FullUrlPattern\]\]/g) {
  45. push(@links, $1) unless $1 eq $ScriptName or $1 eq $FullUrl;
  46. }
  47. my $msg = GetParam('msg', '');
  48. foreach my $uri (@links) {
  49. next if $uri eq $ScriptName or $uri eq $FullUrl;
  50. require LWP::UserAgent;
  51. my $ua = LWP::UserAgent->new;
  52. my %params = ( title=>$id,
  53. text=>$data,
  54. raw=>1,
  55. username=>$user,
  56. pwd=>GetParam('pwd',''),
  57. summary=>$summary, );
  58. $params{recent_edit} = 'on' if $minor;
  59. my $response = $ua->post($uri, \%params);
  60. my $status = $response->code . ' ' . $response->message;
  61. warn "Result for $uri: $status";
  62. $msg .= ' ' if $msg;
  63. $msg .= $response->is_success
  64. ? Tss('Copy to %1 succeeded: %2.', $uri, $status)
  65. : Tss('Copy to %1 failed: %2.', $uri, $status);
  66. }
  67. SetParam('msg', $msg);
  68. }