wiki.pl: Port some fixes from upstream

[Orgmuse.git] / 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[-q QUESTION] [-a ANSWER] [-z SECRET]
\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.

 -d     Delete target pages instead of providing SOURCE (default: none)
 -s     The summary for RecentChanges (default: none)
 -u     The username for RecentChanges (default: none)
 -p     The password to use for locked pages (default: none)
 -w     The username:password combo for basic authentication (default:none)
 -q     The question number to answer (default: 0, ie. the first question)
 -a     The answer to the question (default: none)
 -z     Alternatively, the secret key (default: question)
 -v     Verbose output for debugging (default: none)

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 post {
  my ($uri, $id, $data, $minor, $summary, $username, $password,
      $question, $answer, $secret) = @_;
  my $ua = RequestAgent->new;
  my %params = (title=>$id, text=>$data, raw=>1,
                username=>$username, pwd=>$password,
                summary=>$summary, question_num=>$question,
                answer=>$answer, $secret=>1,
                recent_edit=>$minor);
  if ($opt_v) {
    foreach my $key (keys %params) {
      my $value = $params{$key} || '(none)';
      $value = substr($value,0,50) . '...'
        if $key eq 'text' and length($value) > 53;
      warn "$key: $value\n";
    }
  }
  my $response = $ua->post($uri, \%params);
  my $status = $response->code . ' ' . $response->message;
  warn "POST $id failed: $status.\n" unless $response->is_success;
}

sub copy {
  my ($source, $replacement, $target, $interval, $minor, $summary,
      $username, $password, $question, $answer, $secret,
      @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;
    post($target, $id, $data, $minor, $summary, $username, $password,
      $question, $answer, $secret);
    sleep($interval);
  }
}

sub main {
  our($opt_m, $opt_i, $opt_t, $opt_d, $opt_s, $opt_u, $opt_p,
      $opt_q, $opt_a, $opt_z);
  getopts('mi:t:d:s:u:p:q:a:z:w: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, $opt_m ? 'on' : '', $opt_s,
       $opt_u, $opt_p, $opt_q, $opt_a, $opt_z||'question',
       @pages);
}

main();