wikiappend 2.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778
  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 3 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, see <http://www.gnu.org/licenses/>.
  18. use strict;
  19. use Getopt::Std;
  20. use LWP::UserAgent;
  21. my $usage = "$0 TARGET PAGENAME [USERNAME] [PASSWORD]\n"
  22. . "Where TARGET is the base URL for the wiki.\n"
  23. . "PAGENAME is the name of the page to be modified.\n"
  24. . "USERNAME is the username to use for the edit.\n"
  25. . "PASSWORD is the password to use if required.\n"
  26. . "Example:\n"
  27. . "echo this will be appended | $0 http://localhost/cgi-bin/wiki.pl \"My Cool Page\" MyName TheEditPassWord\n\n";
  28. sub UrlEncode {
  29. my $str = shift;
  30. return '' unless $str;
  31. my @letters = split(//, $str);
  32. my @safe = ('a' .. 'z', 'A' .. 'Z', '0' .. '9', '-', '_', '.', '!',
  33. '~', '*', "'", '(', ')', '#');
  34. foreach my $letter (@letters) {
  35. my $pattern = quotemeta($letter);
  36. if (not grep(/$pattern/, @safe)) {
  37. $letter = sprintf("%%%02x", ord($letter));
  38. }
  39. }
  40. return join('', @letters);
  41. }
  42. sub GetRaw {
  43. my ($uri) = @_;
  44. my $ua = LWP::UserAgent->new;
  45. my $response = $ua->get($uri);
  46. return $response->content if $response->is_success;
  47. }
  48. sub PostRaw {
  49. my ($uri, $id, $data, $user, $pwd) = @_;
  50. my $ua = LWP::UserAgent->new;
  51. my $response = $ua->post($uri, {title=>$id, text=>$data, raw=>1,
  52. username=>$user, pwd=>$pwd});
  53. warn "POST $id failed.\n" unless $response->is_success;
  54. }
  55. sub append {
  56. my ($target, $page, $user, $pwd) = @_;
  57. $page =~ s/ /_/g;
  58. $page = UrlEncode ($page);
  59. my $data = GetRaw("$target?action=browse;id=$page;raw=1");
  60. $data .= <STDIN>;
  61. PostRaw($target, $page, $data, $user, $pwd);
  62. }
  63. sub main {
  64. my ($target, $page, $user, $pwd) = @ARGV;
  65. die $usage unless $target;
  66. die $usage unless $page;
  67. append($target, $page, $user, $pwd);
  68. }
  69. main();