add follow_redirects option + test

git-svn-id: http://inkdroid.org/svn/www-wikipedia/trunk@977 4dc5e89f-90f6-0310-ab54-a6a856e7c30e

Changes

@@ -1,6 +1,7 @@
 Revision history for Perl extension WWW::Wikipedia.
 
 1.93    Tue Dec 11 2007
+        - add a setting to control the following of redirect directives
         - switch to Module::Install
 
 1.92    Tue Jan  2 10:07:33 EST 2007

lib/WWW/Wikipedia.pm

@@ -74,19 +74,25 @@ you have full access.
     my $wiki = WWW::Wikipedia->new();
     $wiki->timeout( 2 );
 
+
+You can turn off the following of wikipedia redirect directives by passing
+a false value to C<follow_redirects>.
+
 =cut
 
 sub new {
     my ( $class, %opts ) = @_;
 
-    my $language = $opts{ language } || 'en';
-    delete $opts{ language };
+    my $language = delete $opts{ language } || 'en';
+    my $follow = delete $opts{ follow_redirects };
+    $follow = 1 if !defined $follow;
 
     my $self = LWP::UserAgent->new( %opts );
     $self->agent( 'WWW::Wikipedia' );
     bless $self, ref( $class ) || $class;
 
     $self->language( $language );
+    $self->follow_redirects( $follow );
     $self->parse_head( 0 );
     return $self;
 }
@@ -109,6 +115,19 @@ sub language {
     return $self->{ language };
 }
 
+=head2 follow_redirects()
+
+By default, wikipeda redirect directives are followed. Set this to false to
+turn that off.
+
+=cut
+
+sub follow_redirects {
+    my ( $self, $value ) = @_;
+    $self->{ follow_redirects } = $value if defined $value;
+    return $self->{ follow_redirects };
+}
+
 =head2 search() 
 
 Which performs the search and returns a WWW::Wikipedia::Entry object which 
@@ -136,7 +155,9 @@ sub search {
         my $entry = WWW::Wikipedia::Entry->new( $response->content(), $src );
 
         # look for a wikipedia style redirect and process if necessary
-        return $self->search( $1 ) if $entry->text() =~ /^#REDIRECT (.*)/i;
+        return $self->search( $1 )
+            if $self->follow_redirects
+                && $entry->text() =~ /^#REDIRECT (.*)/i;
 
         return ( $entry );
     }
@@ -207,13 +228,9 @@ sub error {
 
 =head1 AUTHORS
 
-=over 4
-
-=item * Ed Summers E<lt>ehs@pobox.comE<gt>
-
-=item * Brian Cassidy E<lt>bricas@cpan.orgE<gt>
+Ed Summers E<lt>ehs@pobox.comE<gt>
 
-=back
+Brian Cassidy E<lt>bricas@cpan.orgE<gt>
 
 =head1 COPYRIGHT AND LICENSE
 

lib/WWW/Wikipedia/Entry.pm

@@ -264,13 +264,9 @@ sub _pretty {
 
 =head1 AUTHORS
 
-=over 4
+Ed Summers E<lt>ehs@pobox.comE<gt>
 
-=item * Ed Summers E<lt>ehs@pobox.comE<gt>
-
-=item * Brian Cassidy E<lt>bricas@cpan.orgE<gt>
-
-=back
+Brian Cassidy E<lt>bricas@cpan.orgE<gt>
 
 =cut
 

t/10.load.t

@@ -1,3 +1,6 @@
+use strict;
+use warnings;
+
 use Test::More ( tests => 1 );
 
 use_ok( 'WWW::Wikipedia' );

t/11.language.t

@@ -1,3 +1,6 @@
+use strict;
+use warnings;
+
 use Test::More tests => 7;
 
 use WWW::Wikipedia;

t/16.entry_language.t

@@ -1,6 +1,6 @@
 use strict;
 use warnings;
-use Test::More qw( no_plan );
+use Test::More tests => 7;
 
 use_ok( 'WWW::Wikipedia::Entry' );
 

t/20.search.t

@@ -1,3 +1,6 @@
+use strict;
+use warnings;
+
 use Test::More tests => 7;
 
 use WWW::Wikipedia;

t/21.random.t

@@ -1,3 +1,5 @@
+use strict;
+use warnings;
 use Test::More tests => 4;
 
 use WWW::Wikipedia;

t/25.search_error.t

@@ -1,3 +1,5 @@
+use strict;
+use warnings;
 use Test::More tests => 3;
 
 package WWW::Wikipedia;

t/26.autoformat.t

@@ -1,6 +1,7 @@
+use strict;
+use warnings;
 use Test::More qw( no_plan );
 use WWW::Wikipedia;
-use strict;
 
 # Text::Autoformat has had some bugs which some wikipedia content
 # has been known to trigger. Make sure we cover those bases.

t/30.ua.t

@@ -1,7 +1,6 @@
-use Test::More tests => 2;
-
 use strict;
 use warnings;
+use Test::More tests => 2;
 
 use_ok( 'WWW::Wikipedia' );
 

t/40.redirect.t

@@ -1,10 +1,25 @@
-use Test::More tests => 2;
+use strict;
+use warnings;
+
+use Test::More tests => 4;
 use WWW::Wikipedia;
 
-# test to make sure redirects in content are followed
 # the use of 'Systems Theory' over time may need to change
+my $q    = 'Systems Theory';
+my $wiki = WWW::Wikipedia->new();
+
+# test to make sure redirects in content are followed
+{
+    my $entry = $wiki->search( $q );
+    isa_ok $entry, 'WWW::Wikipedia::Entry';
+    unlike $entry->text(), qr/REDIRECT/, 'redirect not found';
+}
 
-$wiki  = WWW::Wikipedia->new();
-$entry = $wiki->search( 'Systems Theory' );
-isa_ok $entry, 'WWW::Wikipedia::Entry';
-unlike $entry->text(), qr/REDIRECT/, 'redirect not found';
+# test to make sure redirects in content are not followed
+# when follow_redirects == 0
+{
+    $wiki->follow_redirects( 0 );
+    my $entry = $wiki->search( $q );
+    isa_ok $entry, 'WWW::Wikipedia::Entry';
+    like $entry->text(), qr/REDIRECT/, 'redirect found';
+}

t/98.pod.t

@@ -1,3 +1,5 @@
+use strict;
+use warnings;
 use Test::More;
 
 eval "use Test::Pod 1.00";

t/99.pod_coverage.t

@@ -1,3 +1,5 @@
+use strict;
+use warnings;
 use Test::More;
 eval "use Test::Pod::Coverage 1.00";
 plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage"