User:Green Dragon/wikiplbot

1. !/usr/bin/perl

package CMS::MediaWiki;

2. Author: Reto Schär
3. Copyright (C) by Reto Schär (find details at the end of this script)
5. This library is free software; you can redistribute it and/or modify
6. it under the same terms as Perl itself, either Perl version 5.8.6 or,
7. at your option, any later version of Perl 5 you may have available.
9. Locations:
10. http://meta.pgate.net/cms-mediawiki/
11. http://search.cpan.org/dist/CMS-MediaWiki/lib/CMS/MediaWiki.pm
13. Find more MediaWiki reference in general on:
14. http://www.infocopter.com/know-how/mediawiki-reference/

use strict; my $package = __PACKAGE__; our $VERSION = '0.8013';

use LWP::UserAgent; use HTTP::Request::Common;

1. GLOBAL VARIABLES

my %Var = (); my $contentType = ""; my $ua;

$| = 1;

1. ----- FORWARD DECLARATIONS & PROTOTYPING

sub Error($); sub Debug($);

sub new { my $type = shift; my %params = @_; my $self = {};

$self->{'protocol'} = $params{'protocol'} || 'http'; # optional $self->{'host' } = $params{'host'} || 'localhost'; $self->{'path' } = $params{'path'} || ; $self->{'debug' } = $params{'debug'} || 0; # 0, 1, 2 $Var{'SERVER_SIG'} = '*Unknown*'; $Var{'EDIT_TIME_BEFORE'} = '*Unknown*';

Debug "$package V$VERSION" if $self->{'debug'};

$ua = LWP::UserAgent->new( agent => 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0; T312461)' , 'cookie_jar' => {file => "lwpcookies.txt", autosave => 1} );

bless $self, $type; }

sub login { my $self = shift; my %args = @_;

if ($self->{'debug'}) { Debug "[login] $_ = $args{$_}" foreach keys %args; }

$args{'protocol'} ||= $self->{'protocol'}; $args{'path'} ||= $self->{'path'}; $self->{'path'} = $args{'path'}; # globalize, if it was set here

$args{'host'} ||= $self->{'host'}; $self->{'host'} = $args{'host'}; # globalize

my %tags = (); $tags{'wpName' } = $args{'user'} || 'Perlbot'; $tags{'wpPassword' } = $args{'pass'} || 'barfoo'; $tags{'wpLoginattempt'} = 'Log in';

my $index_path = "/index.php"; $index_path = "/$args{'path'}/index.php" if $args{'path'};

my $login_url = "$args{'protocol'}://$args{'host'}$index_path?title=Special:Userlogin&action=submitlogin";

Debug "[login] POST $login_url\..." if $self->{'debug'};

my $resp = $ua->request( POST $login_url , Content_Type => 'application/x-www-form-urlencoded' , Content => [ %tags ] );

my $login_okay = 0; foreach (keys %{$resp->{'_headers'}}) { Debug "(header) $_ = " . $resp->{'_headers'}->{$_} if $self->{'debug'} > 1; if ($_ =~ /^set-cookie$/i) { my $arr = $resp->{'_headers'}->{$_}; if ($arr =~ /^ARRAY(.+)$/) { foreach (@{$arr}) { Debug "- (cookie) $_" if $self->{'debug'} > 1; # wikiUserID or wikidbUserID if ($_ =~ /UserID=\d+\;/i) { # Success! $login_okay = 1; } Debug "(cookie) $_" if $self->{'debug'} > 1; } } else { Debug "=====> cookie: $arr" if $self->{'debug'}; } } if ($_ =~ /^server$/i) { $Var{'SERVER_SIG'} = $resp->{'_headers'}->{$_}; } }

return $login_okay ? 0 : 1; }

sub editPage { my $self = shift; my %args = @_;

if ($self->{'debug'}) { Debug "[editPage] $_ = \"$args{$_}\"" foreach keys %args; Debug "[editPage] VAR $_ = \"$Var{$_}\"" foreach keys %Var; }

my $WHOST = $self->{'host'} || 'localhost'; my $WPATH = $self->{'path'} || ;

$args{'protocol'} ||= $self->{'protocol'}; $args{'text '} ||= '* No text *'; $args{'summary'} ||= 'By CMS::MediaWiki'; $args{'section'} ||= ;

Debug "Editing page '$args{'title'}' (section '$args{'section'}')..." if $self->{'debug'};

my $edit_section = length($args{'section'}) > 0 ? "\&section=$args{'section'}" : ;

# (Pre-)fetch page... my $resp = $ua->request(GET "$args{'protocol'}://$WHOST/$WPATH/index.php?title=$args{'title'}&action=edit$edit_section"); my @lines = split /\n/, $resp->content(); my $token = my $edit_time = ; foreach (@lines) { #Debug "X $_"; if (/wpEditToken/) { s/type=.?hidden.? *value="(.+)" *name/$1/i; $token = $1; } if (/wpEdittime/) { s/type=.?hidden.? *value="(.+)" *name/$1/i; $edit_time = $1 || ; $Var{EDIT_TIME_BEFORE} = $edit_time; } if (/<title>/i) { s/<title>(.+)<\/title>/$1/i; $Var{PAGE_TITLE} = $1 || ; } if (/index.php\?title=(.+?):Copyright.+/i) { $Var{WIKI_NAME} = $1 || ; } }

if ($self->{'debug'}) { Debug "token = $token" if $self->{'debug'} > 1; Debug "edit_time (before update) = $edit_time"; }

my %tags = (); $tags{'wpTextbox1' } = $args{'text'}; $tags{'wpEdittime' } = $edit_time; $tags{'wpSave' } = 'Save page'; $tags{'wpSection' } = $args{'section'}; $tags{'wpSummary' } = $args{'summary'}; $tags{'wpEditToken'} = $token;

$tags{'title' } = $args{'title'}; $tags{'action' } = 'submit';

$resp = $ua->request( POST "$args{'protocol'}://$WHOST/$WPATH/index.php?title=$args{'title'}&action=submit" , Content_Type => 'application/x-www-form-urlencoded' , Content => [ %tags ] );

foreach (sort keys %{$resp->{'_headers'}}) { Debug "(header) $_ = " . $resp->{'_headers'}->{$_} if $self->{'debug'} > 1; } my $response_location = $resp->{'_headers'}->{'location'} || ; Debug "Response Location: $response_location" if $self->{'debug'}; Debug "Comparing with \"/$args{'title'}\"" if $self->{'debug'}; if ($response_location =~ /[\/=]$args{'title'}/i) { Debug "Success!" if $self->{'debug'}; return 0; } else { Debug "NOK!" if $self->{'debug'}; return 1; } }

sub get { my $self = shift; my $Key = shift; $Var{$Key}; }

sub let { my $self = shift; my $Key = shift; my $Value = shift; Debug "[let] $Key = $Value" if $self->{'debug'}; $Var{$Key} = $Value; }

sub getPage { # returns arrayref of lines of page source # Function created by Matt Hucke <hucke@nospam-cynico.net> my ($self, %args) = @_;

$args{'protocol'} ||= $self->{'protocol'}; $args{'section' } ||= 0;

if ($self->{'debug'}) { Debug "[getPage] $_ = \"$args{$_}\"" foreach keys %args; Debug "[getPage] VAR $_ = \"$Var{$_}\"" foreach keys %Var; }

my $WHOST = $self->{'host'} || 'localhost'; my $WPATH = $self->{'path'} || ;

Debug "Fetching page '$args{'title'}' (section '$args{'section'}')..." if $self->{'debug'};

my $edit_section = $args{'section'} ? "\&section=$args{'section'}" : ; my $resp = $ua->request(GET "$args{'protocol'}://$WHOST/$WPATH/index.php?title=$args{'title'}&action=edit$edit_section"); my @lines = split /\n/, $resp->content();

my @content = (); my $saving = 0;

# This is a very simple parser - it looks for <textarea...wpTextbox1> and </textarea> # and returns everything in between. for (my $jj = 0; $jj <= $#lines; $jj++) { my $line = $lines[$jj];

if ($line =~ m/<textarea.*wpTextbox1/) { $saving = 1;

if ($line =~ m/<textarea[^>]+>(.*)/) { $line = $1; # strip out <textarea.....>, keep what's after. } else { # ADVANCE to next line ++$jj; $line = $lines[$jj];

# strip out end of textarea tag at start of line $line =~ s#^[^>]+>##; }

# if any of $line remains, fall thru to 'push' part. next unless ($line);

} elsif ($line =~ m#(.*)</textarea>#) { push (@content, $line) if ($saving && $1); $saving = 0; } push (@content, $line) if ($saving); }

# Always return an arrayref for later processing \@content; }

sub Error ($) { print "Content-type: text/html\n\n" unless $contentType; print "ERROR ($package): $_[0]\n"; exit(1); }

sub Debug ($) { print "[ $package ] $_[0]\n"; }

1. 1. 1. 1. Used Warning / Error Codes ##########################
2. Next free W Code: 1000
3. Next free E Code: 1000

1;

__END__

=head1 NAME

CMS::MediaWiki - Perl extension for creating, reading and updating MediaWiki pages

=head1 SYNOPSIS

 use CMS::MediaWiki;

 my $mw = CMS::MediaWiki->new(

# protocol => 'https', # Optional, default is http host => 'localhost', # Default: localhost path => 'wiki' , # Can be empty on 3rd-level domain Wikis debug => 0 # Optional. 0=no debug msgs, 1=some msgs, 2=more msgs

 );

=head1 DESCRIPTION

Create or update MediaWiki pages. An update of a MediaWiki page can also be reduced to a specific page section. You may update many pages with the same object handle ($mw in the shown example).

You could change the login name between an update. This might be necessary if you would like to update a public page *and* a protected page by the WikiSysop user in just one cycle.

=head2 Login example

 if ($mw->login(user => 'Reto', pass => 'yourpass')) {

print STDERR "Could not login\n"; exit;

 }
 else {

# Logged in. Do stuff ...

 }

=head2 Another login example

 $rc = $mw->login(

protocol => 'https', # optional, default is http host => 'localhost' , # optional here, but wins if (re-)set here path => 'wiki', # optional here, but wins user => 'Reto' , # default: Perlbot pass => 'yourpass' ,

 );

=head2 Edit a Wiki page or section

 $rc = $mw->editPage(

title => 'Online_Directory:Computers:Software:Internet:Authoring' ,

   	section =>  ,	#  2 means edit second section etc.
      	                #  = no section means edit the full page

      	text    => "== Your Section Title ==\nbar foo\n\n",

summary => "Your summary." , # optional

 );

=head2 Get a Wiki page or a section of a Wiki page

 $lines_ref = $mw->getPage(title => 'Perl_driven', section => 1); # omit section to get full page

 # Process Wiki lines ...
 print sprintf('%08d ', ++$i), " $_\n" foreach @$lines_ref;

In general, $rc returns 0 on success unequal 0 on failure.

=head3 Tip

After a successful call of the B<editPage> function you had the following information available:

 print "Edit time (before) was ", $mw->get('EDIT_TIME_BEFORE'), "\n";
 print "Page title was "        , $mw->get('PAGE_TITLE')      , "\n";
 print "The Wiki name was "     , $mw->get('WIKI_NAME')       , "\n";

=head2 EXPORT

None by default.

=head1 SEE ALSO

=item *

http://meta.pgate.net/cms-mediawiki/

=item *

http://www.infocopter.com/perl/modules/

=item *

http://www.infocopter.com/know-how/mediawiki-reference/

=head1 AUTHOR

Reto Schaer, E<lt>retoh@nospam-cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2005-2007 by Reto Schaer

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.6 or, at your option, any later version of Perl 5 you may have available.

http://www.infocopter.com/perl/licencing.html

=cut

print "Hello, World.......\n";

use CMS::MediaWiki;

 my $mw = CMS::MediaWiki->new(
       # protocol => 'https',  # Optional, default is http
       host  => 'localhost',   # Default: localhost
       path  => 'wiki' ,       # Can be empty on 3rd-level domain Wikis
       debug => 0              # Optional. 0=no debug msgs, 1=some msgs, 2=more msgs
 );

print "Hello, World.......\n";