File Coverage

blib/lib/CMS/MediaWiki.pm
Criterion Covered Total %
statement 9 151 5.9
branch 0 78 0.0
condition 0 56 0.0
subroutine 3 11 27.2
pod 1 8 12.5
total 13 304 4.2


line stmt bran cond sub pod time code
1             package CMS::MediaWiki;
2             #######################################################################
3             # Author: Reto Schär
4             # Copyright (C) by Reto Schär (find details at the end of this script)
5             #
6             # This library is free software; you can redistribute it and/or modify
7             # it under the same terms as Perl itself, either Perl version 5.8.6 or,
8             # at your option, any later version of Perl 5 you may have available.
9             #
10             # Locations:
11             # http://meta.pgate.net/cms-mediawiki/
12             # http://search.cpan.org/dist/CMS-MediaWiki/lib/CMS/MediaWiki.pm
13             #######################################################################
14 1     1   30235 use strict;
  1         2  
  1         62  
15             my $package = __PACKAGE__;
16             our $VERSION = '0.8014';
17              
18 1     1   1232 use LWP::UserAgent;
  1         56269  
  1         41  
19 1     1   1082 use HTTP::Request::Common;
  1         2332  
  1         2526  
20              
21             # GLOBAL VARIABLES
22             my %Var = ();
23             my $contentType = "";
24             my $ua;
25              
26             $| = 1;
27              
28             #----- FORWARD DECLARATIONS & PROTOTYPING
29             sub Error($);
30             sub Debug($);
31              
32             sub new {
33 0     0 0   my $type = shift;
34 0           my %params = @_;
35 0           my $self = {};
36              
37 0   0       $self->{'protocol'} = $params{'protocol'} || 'http'; # optional
38 0   0       $self->{'host' } = $params{'host'} || 'localhost';
39 0   0       $self->{'path' } = $params{'path'} || '';
40 0   0       $self->{'debug' } = $params{'debug'} || 0; # 0, 1, 2
41 0           $Var{'SERVER_SIG'} = '*Unknown*';
42 0           $Var{'EDIT_TIME_BEFORE'} = '*Unknown*';
43              
44 0 0         Debug "$package V$VERSION" if $self->{'debug'};
45              
46 0           $ua = LWP::UserAgent->new(
47             agent => 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0; T312461)' ,
48             'cookie_jar' => {file => "lwpcookies.txt", autosave => 1}
49             );
50              
51 0           bless $self, $type;
52             }
53              
54             sub login {
55 0     0 1   my $self = shift;
56 0           my %args = @_;
57              
58 0 0         if ($self->{'debug'}) {
59 0           Debug "[login] $_ = $args{$_}" foreach keys %args;
60             }
61              
62 0   0       $args{'protocol'} ||= $self->{'protocol'};
63 0   0       $args{'path'} ||= $self->{'path'};
64 0           $self->{'path'} = $args{'path'}; # globalize, if it was set here
65              
66 0   0       $args{'host'} ||= $self->{'host'};
67 0           $self->{'host'} = $args{'host'}; # globalize
68              
69 0           my %tags = ();
70 0   0       $tags{'wpName' } = $args{'user'} || 'Perlbot';
71 0   0       $tags{'wpPassword' } = $args{'pass'} || 'barfoo';
72 0           $tags{'wpLoginattempt'} = 'Log in';
73              
74 0           my $index_path = "/index.php";
75 0 0         $index_path = "/$args{'path'}/index.php" if $args{'path'};
76              
77 0           my $login_url = "$args{'protocol'}://$args{'host'}$index_path?title=Special:Userlogin&action=submitlogin";
78              
79 0 0         Debug "[login] POST $login_url\..." if $self->{'debug'};
80              
81 0           my $resp = $ua->request(
82             POST $login_url ,
83             Content_Type => 'application/x-www-form-urlencoded' ,
84             Content => [ %tags ]
85             );
86              
87 0           my $login_okay = 0;
88 0           foreach (keys %{$resp->{'_headers'}}) {
  0            
89 0 0         Debug "(header) $_ = " . $resp->{'_headers'}->{$_} if $self->{'debug'} > 1;
90 0 0         if ($_ =~ /^set-cookie$/i) {
91 0           my $arr = $resp->{'_headers'}->{$_};
92 0 0         if ($arr =~ /^ARRAY(.+)$/) {
93 0           foreach (@{$arr}) {
  0            
94 0 0         Debug "- (cookie) $_" if $self->{'debug'} > 1;
95             # wikiUserID or wikidbUserID
96 0 0         if ($_ =~ /UserID=\d+\;/i) {
97             # Success!
98 0           $login_okay = 1;
99             }
100 0 0         Debug "(cookie) $_" if $self->{'debug'} > 1;
101             }
102             }
103             else {
104 0 0         Debug "=====> cookie: $arr" if $self->{'debug'};
105             }
106             }
107 0 0         if ($_ =~ /^server$/i) {
108 0           $Var{'SERVER_SIG'} = $resp->{'_headers'}->{$_};
109             }
110             }
111              
112 0 0         return $login_okay ? 0 : 1;
113             }
114              
115             sub editPage {
116 0     0 0   my $self = shift;
117 0           my %args = @_;
118              
119 0 0         if ($self->{'debug'}) {
120 0           Debug "[editPage] $_ = \"$args{$_}\"" foreach keys %args;
121 0           Debug "[editPage] VAR $_ = \"$Var{$_}\"" foreach keys %Var;
122             }
123              
124 0   0       my $WHOST = $self->{'host'} || 'localhost';
125 0   0       my $WPATH = $self->{'path'} || '';
126              
127 0   0       $args{'protocol'} ||= $self->{'protocol'};
128 0   0       $args{'text '} ||= '* No text *';
129 0   0       $args{'summary'} ||= 'By CMS::MediaWiki';
130 0   0       $args{'section'} ||= '';
131 0   0       $args{'watch'} ||= 0;
132              
133 0 0         Debug "Editing page '$args{'title'}' (section '$args{'section'}')..." if $self->{'debug'};
134              
135 0 0         my $edit_section = length($args{'section'}) > 0 ? "\§ion=$args{'section'}" : '';
136              
137             # (Pre-)fetch page...
138 0           my $resp = $ua->request(GET "$args{'protocol'}://$WHOST/$WPATH/index.php?title=$args{'title'}&action=edit$edit_section");
139 0           my @lines = split /\n/, $resp->content();
140 0           my $token = my $edit_time = '';
141 0           foreach (@lines) {
142             #Debug "X $_";
143 0 0         if (/wpEditToken/) {
144 0           s/type=.?hidden.? *value="(.+)" *name/$1/i;
145 0           $token = $1;
146             }
147 0 0         if (/wpEdittime/) {
148 0           s/type=.?hidden.? *value="(.+)" *name/$1/i;
149 0   0       $edit_time = $1 || '';
150 0           $Var{EDIT_TIME_BEFORE} = $edit_time;
151             }
152 0 0         if (//i) { </td> </tr> <tr> <td class="h" > <a name="153">153</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> s/<title>(.+)<\/title>/$1/i; </td> </tr> <tr> <td class="h" > <a name="154">154</a> </td> <td class="c0" > 0 </td> <td >   </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--condition.html#154-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $Var{PAGE_TITLE} = $1 || ''; </td> </tr> <tr> <td class="h" > <a name="155">155</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="156">156</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--branch.html#156-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if (/index.php\?title=(.+?):Copyright.+/i) { </td> </tr> <tr> <td class="h" > <a name="157">157</a> </td> <td class="c0" > 0 </td> <td >   </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--condition.html#157-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $Var{WIKI_NAME} = $1 || ''; </td> </tr> <tr> <td class="h" > <a name="158">158</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="159">159</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="160">160</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="161">161</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--branch.html#161-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ($self->{'debug'}) { </td> </tr> <tr> <td class="h" > <a name="162">162</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--branch.html#162-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Debug "token = $token" if $self->{'debug'} > 1; </td> </tr> <tr> <td class="h" > <a name="163">163</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Debug "edit_time (before update) = $edit_time"; </td> </tr> <tr> <td class="h" > <a name="164">164</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="165">165</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="166">166</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my %tags = (); </td> </tr> <tr> <td class="h" > <a name="167">167</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $tags{'wpTextbox1' } = $args{'text'}; </td> </tr> <tr> <td class="h" > <a name="168">168</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $tags{'wpEdittime' } = $edit_time; </td> </tr> <tr> <td class="h" > <a name="169">169</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $tags{'wpSave' } = 'Save page'; </td> </tr> <tr> <td class="h" > <a name="170">170</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $tags{'wpSection' } = $args{'section'}; </td> </tr> <tr> <td class="h" > <a name="171">171</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $tags{'wpSummary' } = $args{'summary'}; </td> </tr> <tr> <td class="h" > <a name="172">172</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $tags{'wpEditToken'} = $token; </td> </tr> <tr> <td class="h" > <a name="173">173</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $tags{'wpWatchthis'} = $args{'watch'}; </td> </tr> <tr> <td class="h" > <a name="174">174</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="175">175</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $tags{'title' } = $args{'title'}; </td> </tr> <tr> <td class="h" > <a name="176">176</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $tags{'action' } = 'submit'; </td> </tr> <tr> <td class="h" > <a name="177">177</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="178">178</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $resp = $ua->request( </td> </tr> <tr> <td class="h" > <a name="179">179</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> POST "$args{'protocol'}://$WHOST/$WPATH/index.php?title=$args{'title'}&action=submit" , </td> </tr> <tr> <td class="h" > <a name="180">180</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Content_Type => 'application/x-www-form-urlencoded' , </td> </tr> <tr> <td class="h" > <a name="181">181</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Content => [ %tags ] </td> </tr> <tr> <td class="h" > <a name="182">182</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ); </td> </tr> <tr> <td class="h" > <a name="183">183</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="184">184</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> foreach (sort keys %{$resp->{'_headers'}}) { </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="185">185</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--branch.html#185-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Debug "(header) $_ = " . $resp->{'_headers'}->{$_} if $self->{'debug'} > 1; </td> </tr> <tr> <td class="h" > <a name="186">186</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="187">187</a> </td> <td class="c0" > 0 </td> <td >   </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--condition.html#187-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $response_location = $resp->{'_headers'}->{'location'} || ''; </td> </tr> <tr> <td class="h" > <a name="188">188</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--branch.html#188-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Debug "Response Location: $response_location" if $self->{'debug'}; </td> </tr> <tr> <td class="h" > <a name="189">189</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--branch.html#189-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Debug "Comparing with \"/$args{'title'}\"" if $self->{'debug'}; </td> </tr> <tr> <td class="h" > <a name="190">190</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--branch.html#190-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ($response_location =~ /[\/=]$args{'title'}/i) { </td> </tr> <tr> <td class="h" > <a name="191">191</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--branch.html#191-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Debug "Success!" if $self->{'debug'}; </td> </tr> <tr> <td class="h" > <a name="192">192</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> return 0; </td> </tr> <tr> <td class="h" > <a name="193">193</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="194">194</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> else { </td> </tr> <tr> <td class="h" > <a name="195">195</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--branch.html#195-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Debug "NOK!" if $self->{'debug'}; </td> </tr> <tr> <td class="h" > <a name="196">196</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> return 1; </td> </tr> <tr> <td class="h" > <a name="197">197</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="198">198</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="199">199</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="200">200</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub get { </td> </tr> <tr> <td class="h" > <a name="201">201</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--subroutine.html#201-1"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--subroutine.html#201-1"> 0 </a> </td> <td >   </td> <td class="s"> my $self = shift; </td> </tr> <tr> <td class="h" > <a name="202">202</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $Key = shift; </td> </tr> <tr> <td class="h" > <a name="203">203</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $Var{$Key}; </td> </tr> <tr> <td class="h" > <a name="204">204</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="205">205</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="206">206</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub let { </td> </tr> <tr> <td class="h" > <a name="207">207</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--subroutine.html#207-1"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--subroutine.html#207-1"> 0 </a> </td> <td >   </td> <td class="s"> my $self = shift; </td> </tr> <tr> <td class="h" > <a name="208">208</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $Key = shift; </td> </tr> <tr> <td class="h" > <a name="209">209</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $Value = shift; </td> </tr> <tr> <td class="h" > <a name="210">210</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--branch.html#210-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Debug "[let] $Key = $Value" if $self->{'debug'}; </td> </tr> <tr> <td class="h" > <a name="211">211</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $Var{$Key} = $Value; </td> </tr> <tr> <td class="h" > <a name="212">212</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="213">213</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="214">214</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub getPage { </td> </tr> <tr> <td class="h" > <a name="215">215</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # returns arrayref of lines of page source </td> </tr> <tr> <td class="h" > <a name="216">216</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # Function created by Matt Hucke <hucke@nospam-cynico.net> </td> </tr> <tr> <td class="h" > <a name="217">217</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--subroutine.html#217-1"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--subroutine.html#217-1"> 0 </a> </td> <td >   </td> <td class="s"> my ($self, %args) = @_; </td> </tr> <tr> <td class="h" > <a name="218">218</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> </td> </tr> <tr> <td class="h" > <a name="219">219</a> </td> <td class="c0" > 0 </td> <td >   </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--condition.html#219-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $args{'protocol'} ||= $self->{'protocol'}; </td> </tr> <tr> <td class="h" > <a name="220">220</a> </td> <td class="c0" > 0 </td> <td >   </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--condition.html#220-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $args{'section' } ||= 0; </td> </tr> <tr> <td class="h" > <a name="221">221</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="222">222</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--branch.html#222-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ($self->{'debug'}) { </td> </tr> <tr> <td class="h" > <a name="223">223</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Debug "[getPage] $_ = \"$args{$_}\"" foreach keys %args; </td> </tr> <tr> <td class="h" > <a name="224">224</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Debug "[getPage] VAR $_ = \"$Var{$_}\"" foreach keys %Var; </td> </tr> <tr> <td class="h" > <a name="225">225</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="226">226</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="227">227</a> </td> <td class="c0" > 0 </td> <td >   </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--condition.html#227-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $WHOST = $self->{'host'} || 'localhost'; </td> </tr> <tr> <td class="h" > <a name="228">228</a> </td> <td class="c0" > 0 </td> <td >   </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--condition.html#228-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $WPATH = $self->{'path'} || ''; </td> </tr> <tr> <td class="h" > <a name="229">229</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="230">230</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--branch.html#230-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Debug "Fetching page '$args{'title'}' (section '$args{'section'}')..." if $self->{'debug'}; </td> </tr> <tr> <td class="h" > <a name="231">231</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="232">232</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--branch.html#232-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $edit_section = $args{'section'} ? "\§ion=$args{'section'}" : ''; </td> </tr> <tr> <td class="h" > <a name="233">233</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $resp = $ua->request(GET "$args{'protocol'}://$WHOST/$WPATH/index.php?title=$args{'title'}&action=edit$edit_section"); </td> </tr> <tr> <td class="h" > <a name="234">234</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my @lines = split /\n/, $resp->content(); </td> </tr> <tr> <td class="h" > <a name="235">235</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="236">236</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my @content = (); </td> </tr> <tr> <td class="h" > <a name="237">237</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $saving = 0; </td> </tr> <tr> <td class="h" > <a name="238">238</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="239">239</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # This is a very simple parser - it looks for <textarea...wpTextbox1> and </textarea> </td> </tr> <tr> <td class="h" > <a name="240">240</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # and returns everything in between. </td> </tr> <tr> <td class="h" > <a name="241">241</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> for (my $jj = 0; $jj <= $#lines; $jj++) { </td> </tr> <tr> <td class="h" > <a name="242">242</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $line = $lines[$jj]; </td> </tr> <tr> <td class="h" > <a name="243">243</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="244">244</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--branch.html#244-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ($line =~ m/<textarea.*wpTextbox1/) { </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--branch.html#-2"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="245">245</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $saving = 1; </td> </tr> <tr> <td class="h" > <a name="246">246</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="247">247</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--branch.html#247-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ($line =~ m/<textarea[^>]+>(.*)/) { </td> </tr> <tr> <td class="h" > <a name="248">248</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $line = $1; # strip out <textarea.....>, keep what's after. </td> </tr> <tr> <td class="h" > <a name="249">249</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } else { </td> </tr> <tr> <td class="h" > <a name="250">250</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # ADVANCE to next line </td> </tr> <tr> <td class="h" > <a name="251">251</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ++$jj; </td> </tr> <tr> <td class="h" > <a name="252">252</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $line = $lines[$jj]; </td> </tr> <tr> <td class="h" > <a name="253">253</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="254">254</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # strip out end of textarea tag at start of line </td> </tr> <tr> <td class="h" > <a name="255">255</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $line =~ s#^[^>]+>##; </td> </tr> <tr> <td class="h" > <a name="256">256</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="257">257</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="258">258</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # if any of $line remains, fall thru to 'push' part. </td> </tr> <tr> <td class="h" > <a name="259">259</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--branch.html#259-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> next unless ($line); </td> </tr> <tr> <td class="h" > <a name="260">260</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="261">261</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } elsif ($line =~ m#(.*)</textarea>#) { </td> </tr> <tr> <td class="h" > <a name="262">262</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--branch.html#262-1"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--condition.html#262-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> push (@content, $line) if ($saving && $1); </td> </tr> <tr> <td class="h" > <a name="263">263</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $saving = 0; </td> </tr> <tr> <td class="h" > <a name="264">264</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="265">265</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--branch.html#265-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> push (@content, $line) if ($saving); </td> </tr> <tr> <td class="h" > <a name="266">266</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="267">267</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="268">268</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # Always return an arrayref for later processing </td> </tr> <tr> <td class="h" > <a name="269">269</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> \@content; </td> </tr> <tr> <td class="h" > <a name="270">270</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="271">271</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="272">272</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub Error ($) { </td> </tr> <tr> <td class="h" > <a name="273">273</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--branch.html#273-1"> 0 </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--subroutine.html#273-1"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--subroutine.html#273-1"> 0 </a> </td> <td >   </td> <td class="s"> print "Content-type: text/html\n\n" unless $contentType; </td> </tr> <tr> <td class="h" > <a name="274">274</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> print "<b>ERROR</b> ($package): $_[0]\n"; </td> </tr> <tr> <td class="h" > <a name="275">275</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> exit(1); </td> </tr> <tr> <td class="h" > <a name="276">276</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="277">277</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="278">278</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--subroutine.html#278-1"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CMS-MediaWiki-pm--subroutine.html#278-1"> 0 </a> </td> <td >   </td> <td class="s"> sub Debug ($) { print "[ $package ] $_[0]\n"; } </td> </tr> <tr> <td class="h" > <a name="279">279</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="280">280</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> #### Used Warning / Error Codes ########################## </td> </tr> <tr> <td class="h" > <a name="281">281</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # Next free W Code: 1000 </td> </tr> <tr> <td class="h" > <a name="282">282</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # Next free E Code: 1000 </td> </tr> <tr> <td class="h" > <a name="283">283</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="284">284</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> 1; </td> </tr> <tr> <td class="h" > <a name="285">285</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="286">286</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> __END__ </td> </tr> </table> </body> </html>