wikiappend 2.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081
  1. #!/usr/bin/perl -w
  2. #
  3. # Copyright (C) 2004 Alex Schroeder <alex@emacswiki.org>
  4. # Copyright (C) 2006 Alexandre (adulau) Dulaunoy
  5. #
  6. # This program is free software; you can redistribute it and/or modify
  7. # it under the terms of the GNU General Public License as published by
  8. # the Free Software Foundation; either version 2 of the License, or
  9. # (at your option) any later version.
  10. #
  11. # This program is distributed in the hope that it will be useful,
  12. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. # GNU General Public License for more details.
  15. #
  16. # You should have received a copy of the GNU General Public License
  17. # along with this program; if not, write to the
  18. # Free Software Foundation, Inc.
  19. # 59 Temple Place, Suite 330
  20. # Boston, MA 02111-1307 USA
  21. use strict;
  22. use Getopt::Std;
  23. use LWP::UserAgent;
  24. my $usage = "$0 TARGET PAGENAME [USERNAME] [PASSWORD]\n"
  25. . "Where TARGET is the base URL for the wiki.\n"
  26. . "PAGENAME is the name of the page to be modified.\n"
  27. . "USERNAME is the username to use for the edit.\n"
  28. . "PASSWORD is the password to use if required.\n"
  29. . "Example:\n"
  30. . "echo this will be appended | $0 http://localhost/cgi-bin/wiki.pl \"My Cool Page\" MyName TheEditPassWord\n\n";
  31. sub UrlEncode {
  32. my $str = shift;
  33. return '' unless $str;
  34. my @letters = split(//, $str);
  35. my @safe = ('a' .. 'z', 'A' .. 'Z', '0' .. '9', '-', '_', '.', '!',
  36. '~', '*', "'", '(', ')', '#');
  37. foreach my $letter (@letters) {
  38. my $pattern = quotemeta($letter);
  39. if (not grep(/$pattern/, @safe)) {
  40. $letter = sprintf("%%%02x", ord($letter));
  41. }
  42. }
  43. return join('', @letters);
  44. }
  45. sub GetRaw {
  46. my ($uri) = @_;
  47. my $ua = LWP::UserAgent->new;
  48. my $response = $ua->get($uri);
  49. return $response->content if $response->is_success;
  50. }
  51. sub PostRaw {
  52. my ($uri, $id, $data, $user, $pwd) = @_;
  53. my $ua = LWP::UserAgent->new;
  54. my $response = $ua->post($uri, {title=>$id, text=>$data, raw=>1,
  55. username=>$user, pwd=>$pwd});
  56. warn "POST $id failed.\n" unless $response->is_success;
  57. }
  58. sub append {
  59. my ($target, $page, $user, $pwd) = @_;
  60. $page =~ s/ /_/g;
  61. $page = UrlEncode ($page);
  62. my $data = GetRaw("$target?action=browse;id=$page;raw=1");
  63. $data .= <STDIN>;
  64. PostRaw($target, $page, $data, $user, $pwd);
  65. }
  66. sub main {
  67. my ($target, $page, $user, $pwd) = @ARGV;
  68. die $usage unless $target;
  69. die $usage unless $page;
  70. append($target, $page, $user, $pwd);
  71. }
  72. main();