oddmuse/wikicopy

#!/usr/bin/perl -w
#
# Copyright (C) 2004, 2005, 2006  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

require LWP;
use Getopt::Std;

our ($opt_v, $opt_w);

# We make our own specialization of LWP::UserAgent that asks for
# user/password if document is protected.
{
  package RequestAgent;
  @ISA = qw(LWP::UserAgent);

  sub new {
    my $self = LWP::UserAgent::new(@_);
    $self;
  }

  sub get_basic_credentials {
    my($self, $realm, $uri) = @_;
    return split(':', $main::opt_w, 2);
  }
}

my $usage = qq{$0 [-i URL] [-d STRING] [-t SECONDS]
\t[-u USERNAME] [-p PASSWORD] [-w USERNAME:PASSWORD]
\t[SOURCE] TARGET

SOURCE and TARGET are the base URLs for the two wikis.  Visiting these
two URLs should show you the respective homepages.

Provide the page names to copy on STDIN or use -i to point to a page.
You can use the index action with the raw parameter from the source
wiki to copy all the pages. See example below.

The list of page names should use the MIME type text/plain.

By default, wikicopy will copy a page every five seconds. Use -t to
override this. SECONDS is the number of seconds to wait between
requests.

If you use -d instead of providing a SOURCE, all the pages will be
replaced with STRING. This is useful when replacing the page content
with "DeletedPage", for example.

Your copies on the target wiki will show up on the list of changes as
anonymous edits. If you want to provide a username, you can use -u to
do so.

If you want to copy pages to a locked wiki or if you need to overwrite
locked target pages, you need to provide a password using -p.

On the other hand, if your wiki is protected by so-called "basic
authentication" -- that is, if you need to provide a username and
password before you can even view the site -- then you can pass
those along using the -w option. Separate username and password
using a colon.

Examples:

wikicopy -i 'http://www.emacswiki.org/cgi-bin/alex?action=index;raw=1' \\
         http://www.emacswiki.org/cgi-bin/alex \\
         http://localhost/cgi-bin/wiki.pl

wikicopy -d DeletedPage http://localhost/cgi-bin/wiki.pl < list.txt

wikicopy -v -u 'ElGordo' -w 'simple:mind' \\
	 -i 'http://www.communitywiki.org/odd/LosAngelesEcoVillage?action=index;raw=1' \\
         'http://www.communitywiki.org/odd/LosAngelesEcoVillage' \\
         'http://www.tentacle.net/~eeio/cgi/wiki.cgi'
};

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 = RequestAgent->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, $username, $password) = @_;
  my $ua = RequestAgent->new;
  my $response = $ua->post($uri, {title=>$id, text=>$data, raw=>1,
				  username=>$username, pwd=>$password});
  my $status = $response->code . ' ' . $response->message;
  warn "POST $id failed: $status.\n" unless $response->is_success;
}

sub copy {
  my ($source, $replacement, $target, $interval, $username, $password,
      @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, $username, $password);
    sleep($interval);
  }
}

sub main {
  our($opt_i, $opt_t, $opt_d, $opt_u, $opt_p);
  getopts('i:t:d:u:p:w:v');
  my $interval = $opt_t ? $opt_t : 5;
  my $replacement = $opt_d;
  my $username = $opt_u;
  my $password = $opt_p;
  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, $username, $password,
       @pages);
}

main();