#!/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();