File Coverage

blib/lib/Mediawiki/Spider.pm
Criterion Covered Total %
statement 15 271 5.5
branch 0 86 0.0
condition 0 12 0.0
subroutine 5 18 27.7
pod 0 13 0.0
total 20 400 5.0


line stmt bran cond sub pod time code
1             package Mediawiki::Spider;
2              
3 1     1   23202 use 5.008006;
  1         4  
  1         42  
4 1     1   8 use strict;
  1         1  
  1         38  
5 1     1   7 use warnings;
  1         7  
  1         43  
6 1     1   1868 use LWP::UserAgent;
  1         63901  
  1         39  
7             #use Data::Dumper;
8 1     1   923 use HTML::Extract;
  1         54044  
  1         5238  
9             require Exporter;
10              
11             our @ISA = qw(Exporter);
12              
13             # Items to export into callers namespace by default. Note: do not export
14             # names by default without a very good reason. Use EXPORT_OK instead.
15             # Do not simply export all your public functions/methods/constants.
16              
17             # This allows declaration use Mediawiki::Spider ':all';
18             # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
19             # will save memory.
20             our %EXPORT_TAGS = ( 'all' => [ qw(
21            
22             ) ] );
23              
24             our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
25              
26             our @EXPORT = qw(
27            
28             );
29              
30             our $VERSION = '0.31';
31              
32              
33             # Preloaded methods go here.
34              
35              
36              
37             sub new {
38 0     0 0   my $package = shift;
39 0           my $self= {
40             _uri=> undef,
41             _wikiwords=> undef,
42             _wikiindex=> undef,
43             _sortedwikiindex=> undef,
44             _extension=>"html",
45             };
46             #return bless({}, $package);
47 0           return bless ($self,$package);
48             }
49              
50             sub urldecode {
51              
52 0     0 0   my ($self,$str) = @_;
53 0           $str =~ s/%([A-Fa-f0-9]{2})/pack('C', hex($1))/seg;
  0            
54              
55 0           return $str;
56             }
57              
58              
59             sub extension {
60 0     0 0   my ($self, $extension)=@_;
61 0 0         $self->{_extension} = $extension if defined($extension);
62 0           return $self->{_extension};
63             }
64              
65             sub seturi {
66 0     0 0   my ( $self, $uri ) = @_;
67 0 0         $self->{_uri} = $uri if defined($uri);
68 0           return $self->{_uri};
69             }
70              
71             sub sortedwikiindex{
72 0     0 0   my ( $self, %sortedwikiindex) = @_;
73 0 0         %{$self->{_sortedwikiindex}} = %sortedwikiindex if %sortedwikiindex ;
  0            
74 0 0         if( defined(%{$self->{_sortedwikiindex}})) {
  0            
75 0           return %{$self->{_sortedwikiindex}};
  0            
76             };
77             }
78              
79             sub wikiindex{
80             # wikiindex; a hash of hashes?
81 0     0 0   my ( $self, %wikiindex) = @_;
82 0 0         %{$self->{_wikiindex}} = %wikiindex if %wikiindex ;
  0            
83 0 0         if( defined(%{$self->{_wikiindex}})) {
  0            
84 0           return %{$self->{_wikiindex}};
  0            
85             };
86             }
87              
88              
89             sub wikiwords{
90 0     0 0   my ( $self, @wikiwords) = @_;
91 0 0         @{$self->{_wikiwords}} = @wikiwords if @wikiwords ;
  0            
92 0 0         if( defined(@{$self->{_wikiwords}})) {
  0            
93 0           return @{$self->{_wikiwords}};
  0            
94             };
95             }
96              
97             sub buildmenu{
98 0     0 0   my ($self,%addedhash)=@_;
99 0           my %wikiindex=$self->wikiindex();
100 0           my %inversion;
101 0           for my $key (keys %wikiindex) {
102 0           for my $key2( keys %{$wikiindex{$key}}){
  0            
103 0 0 0       if($key2 ne "" && $key ne ""){
104 0           $inversion{$key2}->{$key}=1;
105             }
106             }
107             }
108             # print "Inversion: ".Data::Dumper->Dump([%inversion]);
109 0           $self->sortedwikiindex(%inversion);
110 0           return %inversion;
111             }
112              
113             sub makepretty{
114 0     0 0   my($self,$string)=@_;
115 0           $string=~s/\_/\ /g;
116 0           return $string;
117             }
118              
119             sub printmenu{
120             # also get it to put %extras in -- extras should be a hash similar to %inverted
121 0     0 0   my ($self, $page, $extratitle,@extras)=@_;
122 0           my %sortedindex=$self->sortedwikiindex();
123 0           open (FILE2,"
124 0           my @rawheader=;
125 0           my $header=join('',@rawheader);
126 0           close(FILE2);
127              
128 0 0         open(FILEHANDLE, ">$page") || die("($page): cannot open file: ". $!);
129 0           print FILEHANDLE "";
130 0           print FILEHANDLE "\n\n";
131 0           print FILEHANDLE "Index\n \n\n\n";
132 0           print FILEHANDLE "";
133 0           print FILEHANDLE "$header\n";
134 0           print FILEHANDLE "
";
135 0           my $incremental=0;
136 0           for my $key (sort keys %sortedindex) {
137 0           $incremental++;
138             # put in categories you wish to exclude
139 0 0         if($key=~/Exclude/){
    0          
140 0           next;
141             } elsif($key=~/^Category$/){
142 0           next;
143             }
144 0           my $keytoshow=$key;
145 0           $keytoshow=~s/Category\://g;
146 0           $keytoshow=$self->makepretty($keytoshow);
147 0           print FILEHANDLE "\n

$keytoshow

\n

";

148 0           for my $key2 (sort keys %{$sortedindex{$key}}){
  0            
149 0           my $key2toshow=$key2;
150 0 0         if($key2=~/rint_All/){
    0          
151 0           next;
152             } elsif($key2=~/_Context/){
153 0           next;
154             }
155 0           $key2toshow=$self->makepretty($key2toshow);
156 0           print FILEHANDLE "extension()."\">$key2toshow\n";
157 0           print FILEHANDLE "
\n";
158             }
159 0           print FILEHANDLE "

\n";
160            
161             }
162 0 0 0       if($extratitle && $#extras>-1){
163 0           $incremental++;
164 0           print FILEHANDLE "\n

$extratitle

\n

";

165 0           foreach my $key3 (@extras){
166 0           print FILEHANDLE "\nextension()."\">".$self->makepretty($self->urldecode($key3))."\n";
167 0           print FILEHANDLE "
\n";
168             }
169 0           print FILEHANDLE "\n

\n";
170             }
171 0           print FILEHANDLE "\n\n";
172 0           close(FILEHANDLE);
173 0           return;
174             }
175              
176             sub getwikiwords {
177 0     0 0   my ($self,$uri)=@_;
178 0 0         $self->seturi($uri) if defined($uri);
179 0           my @wikiwords;
180 0           my $browser=LWP::UserAgent->new();
181 0           my $content = $browser->get($uri);
182 0 0         if($content->{_rc} eq "200"){
183 0           my $theuri= $content->{_request}->{_uri};
184 0           $theuri=~/^(.*)\//;
185 0           $theuri=$1."/";
186 0           $self->seturi($theuri);
187             #print "URI: $theuri";
188 0           $content=$browser->get($theuri."Special:Allpages");
189 0           my @lines=split(/\/Special:Allpages\//,$content->{_content});
190 0           my $currentwikiword="";
191 0           my @specialpages;
192 0           foreach my $line (@lines){
193 0 0         if ($line=~/^([0-9A-z\-\_\:\%\&\.\,\;\+\#]+)/){
194 0 0         if($1 eq $currentwikiword){
195 0           push(@specialpages,$theuri."Special:Allpages\/".$currentwikiword);
196             } else {
197 0           $currentwikiword=$1;
198            
199             }
200             }
201             #}
202             }
203            
204 0 0         if($#specialpages<0){
205 0           push(@specialpages,$theuri."Special:Allpages\/");
206             }
207            
208 0           foreach my $specialpage (@specialpages){
209 0           $content=$browser->get($specialpage);
210             #my $newcontent=split(/title\=\"Special\:Allpages\"\>All\ pages/,$content);
211 0           my @newcontent;
212 0           @newcontent=split(/Special\:Allpages\"\>All\ pages/,$content->{_content});
213 0           @newcontent=split(/\/,$newcontent[1]);
214 0           @lines=split(/\
215 0           foreach my $line (@lines){
216             #$line=~/title=\"([0-9A-z\-\_\:\%\&\.\,\;\+\#]+)\"/;
217             # print "$line\n\n";
218 0           $line=~/\"\/index\/([^\"^\ *]+)\"/;
219 0 0         if($1){
220 0           push(@wikiwords,$1);
221             # print "Wikiword: ".$1."\n";
222             }
223             }
224             }
225              
226 0 0         if($#wikiwords<0){
227 0           return -2;
228             } else {
229 0           $self->wikiwords(@wikiwords);
230 0           return @wikiwords;
231             }
232            
233            
234             } else {
235             #print "Page does not exist";
236 0           return -1;
237             }
238             }
239              
240             # TODO: clean up this code!!
241              
242             sub do_wikisuck {
243             # Berlin schoenefeld airport, 31st Dec 2006 18.36pm
244             # Recursive wiki suck function; keep going til @categories eq wikiwords
245 0     0 0   my ( $self, $folder,$makecategories,@categories) = @_;
246 0           my $extractor=new HTML::Extract();
247 0           my @wikiwords;
248             my %wikiindex;
249 0           @wikiwords=$self->wikiwords();
250 0           %wikiindex=$self->wikiindex();
251             #print "Wikiwords".Data::Dumper->Dump([@wikiwords])."\n";
252             #print "Wikiindex".Data::Dumper->Dump([%wikiindex])."\n";
253            
254             # TODO: if is redirect then DO NOT SAVE IT!!
255 0           my $uri=$self->seturi();
256 0           $uri=~/(.*)\/(.*)\//;
257 0           my $uriextension=$2;
258 0           my %is_wikiword = ();
259 0           for (@wikiwords) { $is_wikiword{$_} = 1 }
  0            
260             # have to compare @categories and @wikiwords
261 0           my $temptest;
262 0           foreach my $word (@categories){
263 0           $temptest=$word;
264 0           $temptest=~s/\:/\-/g;
265 0 0 0       if($is_wikiword{$word} || $is_wikiword{$temptest}){ # we already did this word (we got the wikiwords from special::allpages)!
    0          
    0          
    0          
    0          
266 0           print "Ignoring $word (already done)\n";
267             # return;
268             } elsif($word=~/http\:\/\/(.*)/){ # no sucking the whole interweb, please!
269 0           print "Ignoring $word (inappropriate) \n";
270             } elsif($word=~/(.*)\.(\w\w|\w\w\w)\/(.*)/){ # thingy.wossname.ac.uk/something?
271 0           print "Ignoring $word (inappropriate) \n";
272             } elsif($word=~/Mediawiki\:/){
273             } elsif($word=~/Special\:/){
274             } else {
275 0           sleep 3;
276 0           print "Looking at $word (do)\n";
277 0           push(@wikiwords,$word); # is this the right way round?
278 0           $is_wikiword{$word}=1;
279 0           $self->wikiwords(@wikiwords); # add that back to the collective 'dealt with' list
280 0           my $text=$extractor->gethtml($uri.$word,"tagid=content");
281 0           $text=~s/\//;
282             #$text=~s/
//;
283 0           my @rawcategories;
284 0 0         if($self->extension()!=""){
285 0           my $ext=$self->extension();
286 0           $text=~s/\"\/$uriextension\/([0-9A-z\-\_\:\%\&\.\,\;\+\#]+)/\"$1\.$ext/g;
287 0           @rawcategories=split(/href=\"([0-9A-z\-\_\:\%\&\.\,\;\+\#]+)\.$ext/,$text);
288             } else {
289 0           $text=~s/\"\/$uriextension\/([0-9A-z\-\_\:\%\&\.\,\;\+\#]+)/\"$1\.html/g;
290 0           @rawcategories=split(/href=\"([0-9A-z\-\_\:\%\&\.\,\;\+\#]+)\.html/,$text);
291             }
292 0 0         if(!$#rawcategories<1){
293 0           foreach my $category (@rawcategories) {
294             # in page $word we found categories @rawcategories
295 0           $category=~/(^[0-9A-Za-z\-\_\:\%\&\.\,\;\+\#]+)$/;
296 0 0         if(!$1 eq ""){
297             #print "Considering category $1\n";
298 0           push(@categories,$1);
299 0           my $topush=$1;
300 0 0 0       if($topush=~/Category/ && !$word=~/Category/){
301 0           print "Pushing $topush\n";
302 0           $wikiindex{$word}->{$topush}=1;
303 0           $self->wikiindex(%wikiindex);
304             }
305             } # check this bit for safety - it may well be possible to craft dangerous wikiwords...
306             }
307 0           $text=~s/href=\"Category:([0-9A-z\-\_\%\&\.\,\;\+\#]+)/href=\"Category-$1/g;
308 0           $word=~s/\:/\-/g;
309              
310             # if page content contains noinclude tag, don't include it
311 0 0         if($text=~/Category:Exclude/){
312 0           print "Not printing $word (excluded)\n";
313             } else {
314 0           $text=~s/\[edit<\/a>\]//g;
315             #$text=~s/\//;
316 0           $text=~s/
317 0           $text=~s/
(.*?)\<\/div\>//;
318 0 0         open(FILEHANDLE, ">$folder/".$self->urldecode($word).".".$self->extension()) || die("($word): cannot open file: ". $!);
319 0           open (FILE2,"
320 0           my @rawheader=;
321 0           my $header=join('',@rawheader);
322 0           close(FILE2);
323 0           print FILEHANDLE "";
324              
325 0           print FILEHANDLE "\n\n$word\n\n \n\n";
326 0           print FILEHANDLE "\n\n";
327 0           print FILEHANDLE "$header\n$text\n";
328 0           print FILEHANDLE "\n\n";
329 0           print FILEHANDLE ""; #sleep 7; #don't go mad if not using this on own site!
330 0           close(FILEHANDLE);
331             }
332             }
333             }
334             }
335 0           my %saw;
336 0           undef %saw;
337 0           my @out = grep(!$saw{$_}++, @categories);
338 0           @categories=@out;
339              
340 0           my @finalcategories;
341 0           %is_wikiword= ();
342 0           for (@wikiwords) { $is_wikiword{$_} = 1 }
  0            
343 0           for(@categories){
344 0 0         if(!$is_wikiword{$_}){
345 0           push(@finalcategories,$_);
346             }
347             }
348             # have to compare @categories and @wikiwords
349 0 0         if($#finalcategories>0){
350             # $self->do_wikisuck($folder,$makecategories,@finalcategories);
351             # no need to actually recurse for this task, it appears... but nonetheless
352 0           print "Left to do:".Data::Dumper->Dump([@finalcategories])."\n";
353 0           print Data::Dumper->Dump([%wikiindex]);
354             }
355             }
356              
357             sub makeflatpages{
358             ## make this thing recursive tomorrow...
359 0     0 0   my ( $self, $folder,$makecategories) = @_;
360 0           my @wikiwords=$self->wikiwords();
361             # print "Wikiwords".Data::Dumper->Dump([@wikiwords])."\n";
362 0           my $extractor=new HTML::Extract();
363 0           my $uri=$self->seturi();
364 0           $uri=~/(.*)\/(.*)\//;
365 0           my $uriextension=$2;
366 0           my @categories;
367             my %wikiindex;
368             # @wikiwords=('Technical_Frameworks_Context');
369 0           foreach my $word (@wikiwords){
370 0 0         if($word=~/http\:\/\/(.*)/){ # no sucking the whole interweb, please!
371 0           print "Looking at $word (ignore) \n";
372             }else { # get page, collect categories...
373 0           sleep 3;
374 0           print "Looking at $word (get page) \n";
375 0           my $text=$extractor->gethtml($uri.$word,"tagid=content");
376 0 0         if($text=~/\\(Redirected from/){
377 0           print "Don't want this word (Is redirect)\n";
378 0           next;
379             }
380             #$text=~s/\//;
381             #$text=~s/
382             #$text=~s/
(.*?)\<\/div\>//;
383 0           $text=~s/\//;
384 0           $text=~s/\"\/$uriextension\/([0-9A-z\-\_\:\%\&\.\,\;\+\#]+)/\"$1\.html/g;
385 0           my @rawcategories=split(/href=\"([0-9A-z\-\_\:\%\&\.\,\;\+]+)\.html\"/,$text);
386             # this buggers up when there are 0 categories.
387 0 0         if($#rawcategories<1){
388 0           print "Raw categories: ".$#rawcategories."\n";
389             } else {
390             # my @rawcategories=split(/href=\"\/$uriextension\/(.*)\"/,$text);
391             # print Data::Dumper->Dump([@rawcategories]);
392 0           foreach my $category (@rawcategories) {
393 0           $category=~/(^[0-9A-Za-z\-\_\:\%\&\.\,\;\+\#]+)$/;
394 0 0         if(!$1 eq ""){
395             #print "Category is $1\n";
396 0           push(@categories,$1);
397 0           my $topush=$1;
398 0 0         if($topush=~/Category/ ){
399             #print "Pushing $topush\n";
400 0           $wikiindex{$word}->{$topush}=1;
401             }
402            
403             }
404             }
405             }
406 0 0         if($text =~ /Category:Exclude/){
407 0           print "Not printing $word (excluded)\n";
408             } else {
409             # Do not have category: files... : in files is bad
410 0           $text=~s/href=\"Category:([0-9A-z\-\_\%\&\.\,\;\+\#]+)/href=\"Category-$1/g;
411             # squelch the '[edit]' links
412 0           $text=~s/\[edit<\/a>\]//g;
413 0           $text=~s/
414 0           $text=~s/
(.*?)\<\/div\>//;
415 0 0         open(FILEHANDLE, ">$folder/$word.".$self->extension()) || die("cannot open file: ". $!);
416 0           open (FILE2,"
417 0           my @rawheader=;
418 0           my $header=join('',@rawheader);
419 0           close(FILE2);
420             #print FILEHANDLE "";
421 0           print FILEHANDLE "";
422 0           print FILEHANDLE "$word ";
423 0           print FILEHANDLE "\n\n";
424 0           print FILEHANDLE "$header\n$text";
425 0           print FILEHANDLE "\n\n";
426 0           print FILEHANDLE "";
427 0           close (FILEHANDLE);
428             #sleep 7; #don't go mad, eh?
429             }
430             }
431 0           my %saw;
432 0           undef %saw;
433 0           my @out = grep(!$saw{$_}++, @categories);
434 0           @categories=@out;
435             # print Data::Dumper->Dump([@categories])."\n";
436             }
437 0           print Data::Dumper->Dump([%wikiindex]);
438 0           $self->wikiindex(%wikiindex);
439 0 0         if($makecategories){
440 0           $self->do_wikisuck($folder,$makecategories,@categories);
441             }
442             }
443              
444             1;
445             __END__