modules/sync.pl

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