forked from github/kensanata.oddmuse
2a80f7f6ce
(GetRaw): Always print status. (copy): Handle replacement text. (main): Accept replacement text.
110 lines
3.5 KiB
Perl
Executable File
110 lines
3.5 KiB
Perl
Executable File
#!/usr/bin/perl -w
|
|
#
|
|
# Copyright (C) 2004, 2005 Alex Schroeder <alex@emacswiki.org>
|
|
#
|
|
# This program is free software; you can redistribute it and/or modify
|
|
# it under the terms of the GNU General Public License as published by
|
|
# the Free Software Foundation; either version 2 of the License, or
|
|
# (at your option) any later version.
|
|
#
|
|
# This program is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with this program; if not, write to the
|
|
# Free Software Foundation, Inc.
|
|
# 59 Temple Place, Suite 330
|
|
# Boston, MA 02111-1307 USA
|
|
|
|
use strict;
|
|
use Getopt::Std;
|
|
use LWP::UserAgent;
|
|
|
|
our $opt_v;
|
|
|
|
my $usage = "$0 [-i URL] [-d STRING] [-t SECONDS] [SOURCE] TARGET\n"
|
|
. "Where SOURCE and TARGET are the base URLs for the two wikis.\n"
|
|
. "Provide the page names on STDIN or use -i to point to a page.\n"
|
|
. "URL is the raw URL returning page names if you want to copy it all.\n"
|
|
. "The list of page names should use the MIME type text/plain."
|
|
. "SECONDS is the number of seconds to wait between requests.\n"
|
|
. "If you use -d instead of providing a SOURCE, all the pages\n"
|
|
. "will be replaced with STRING.\n"
|
|
. "Example:\n\n"
|
|
. "wikicopy -i 'http://www.emacswiki.org/cgi-bin/alex?action=index;raw=1' \\\n"
|
|
. " http://www.emacswiki.org/cgi-bin/alex \\\n"
|
|
. " http://localhost/cgi-bin/wiki.pl\n"
|
|
. "cat list.txt | wikicopy -d DeletedPage http://localhost/cgi-bin/wiki.pl\n";
|
|
|
|
sub UrlEncode {
|
|
my $str = shift;
|
|
return '' unless $str;
|
|
my @letters = split(//, $str);
|
|
my @safe = ('a' .. 'z', 'A' .. 'Z', '0' .. '9', '-', '_', '.', '!', '~', '*', "'", '(', ')', '#');
|
|
foreach my $letter (@letters) {
|
|
my $pattern = quotemeta($letter);
|
|
if (not grep(/$pattern/, @safe)) {
|
|
$letter = sprintf("%%%02x", ord($letter));
|
|
}
|
|
}
|
|
return join('', @letters);
|
|
}
|
|
|
|
sub GetRaw {
|
|
my ($uri) = @_;
|
|
my $ua = LWP::UserAgent->new;
|
|
my $response = $ua->get($uri);
|
|
print "no response\n" unless $response->code;
|
|
print "GET ", $response->code, " ", $response->message, "\n" if $opt_v;
|
|
return $response->content if $response->is_success;
|
|
}
|
|
|
|
sub PostRaw {
|
|
my ($uri, $id, $data) = @_;
|
|
my $ua = LWP::UserAgent->new;
|
|
my $response = $ua->post($uri, {title=>$id, text=>$data, raw=>1}); # fix for other wikis
|
|
my $status = $response->code . ' ' . $response->message;
|
|
warn "POST $id failed: $status.\n" unless $response->is_success;
|
|
}
|
|
|
|
sub copy {
|
|
my ($source, $replacement, $target, $interval, @pages) = @_;
|
|
foreach my $id (@pages) {
|
|
print "$id\n";
|
|
my $page = UrlEncode ($id);
|
|
# fix URL for other wikis
|
|
my $data = $replacement || GetRaw("$source?action=browse;id=$page;raw=1");
|
|
next unless $data;
|
|
PostRaw($target, $id, $data);
|
|
sleep($interval);
|
|
}
|
|
}
|
|
|
|
sub main {
|
|
our($opt_i, $opt_t, $opt_d);
|
|
getopts('i:t:d:v');
|
|
my $interval = $opt_t ? $opt_t : 5;
|
|
my $replacement = $opt_d;
|
|
my ($source, $target);
|
|
$source = shift(@ARGV) unless $replacement;
|
|
$target = shift(@ARGV);
|
|
die $usage if not $target or @ARGV; # not enough or too many
|
|
my @pages = ();
|
|
if ($opt_i) {
|
|
my $data = GetRaw($opt_i);
|
|
@pages = split(/\n/, $data);
|
|
} else {
|
|
print "List of pages:\n";
|
|
while (<STDIN>) {
|
|
chomp;
|
|
push(@pages, $_);
|
|
}
|
|
}
|
|
die "The list of pages is missing. Did you use -i?\n" unless @pages;
|
|
copy($source, $replacement, $target, $interval, @pages);
|
|
}
|
|
|
|
main();
|