Merge pull request #111 from kenneth-olwing/master

Make case sensitivity user settable

lib/Pod/Simple/Search.pm

@@ -12,7 +12,6 @@ $SLEEPY = 1 if !defined $SLEEPY and $^O =~ /mswin|mac/i;
   # flag to occasionally sleep for $SLEEPY - 1 seconds.
 
 $MAX_VERSION_WITHIN ||= 60;
-my $IS_CASE_INSENSITIVE = -e uc __FILE__ && -e lc __FILE__;
 
 #############################################################################
 
@@ -26,7 +25,7 @@ use Cwd qw( cwd );
 __PACKAGE__->_accessorize(  # Make my dumb accessor methods
  'callback', 'progress', 'dir_prefix', 'inc', 'laborious', 'limit_glob',
  'limit_re', 'shadows', 'verbose', 'name2path', 'path2name', 'recurse',
- 'ciseen'
+ 'ciseen', 'is_case_insensitive'
 );
 #==========================================================================
 
@@ -42,6 +41,7 @@ sub init {
   $self->inc(1);
   $self->recurse(1);
   $self->verbose(DEBUG);
+  $self->is_case_insensitive(-e uc __FILE__ && -e lc __FILE__);
   return $self;
 }
 
@@ -130,12 +130,12 @@ sub _make_search_callback {
 
   # Put the options in variables, for easy access
   my( $laborious, $verbose, $shadows, $limit_re, $callback, $progress,
-      $path2name, $name2path, $recurse, $ciseen) =
+      $path2name, $name2path, $recurse, $ciseen, $is_case_insensitive) =
     map scalar($self->$_()),
      qw(laborious verbose shadows limit_re callback progress
-        path2name name2path recurse ciseen);
+        path2name name2path recurse ciseen is_case_insensitive);
   my ($seen, $remember, $files_for);
-  if ($IS_CASE_INSENSITIVE) {
+  if ($is_case_insensitive) {
       $seen      = sub { $ciseen->{ lc $_[0] } };
       $remember  = sub { $name2path->{ $_[0] } = $ciseen->{ lc $_[0] } = $_[1]; };
       $files_for = sub { my $n = lc $_[0]; grep { lc $path2name->{$_} eq $n } %{ $path2name } };
@@ -588,7 +588,7 @@ sub find {
       my $fullext = $fullname . $ext;
       if ( -f $fullext and $self->contains_pod($fullext) ) {
         print "FOUND: $fullext\n" if $verbose;
-        if (@parts > 1 && lc $parts[0] eq 'pod' && $IS_CASE_INSENSITIVE && $ext eq '.pod') {
+        if (@parts > 1 && lc $parts[0] eq 'pod' && $self->is_case_insensitive() && $ext eq '.pod') {
           # Well, this file could be for a program (perldoc) but we actually
           # want a module (Pod::Perldoc). So see if there is a .pm with the
           # proper casing.
@@ -849,6 +849,20 @@ inspected too, and are noted in the pathname2podname return hash.
 This attribute's default value is false; and normally you won't
 need to turn it on.
 
+=item $search->is_case_insensitive( I<true-or-false> );
+
+Pod::Simple::Search will by default internally make an assumption
+based on the underlying filesystem where the class file is found
+whether it is case insensitive or not.
+
+If it is determined to be case insensitive, during survey() it may
+skip pod files/modules that happen to be equal to names it's already
+seen, ignoring case.
+
+However, it's possible to have distinct files in different directories
+that intentionally has the same name, just differing in case, that should
+be reported. Hence, you may force the behavior by setting this to true
+or false.
 
 =item $search->limit_re( I<some-regxp> );
 
@@ -857,7 +871,6 @@ to limit the results just to items whose podnames match the given
 regexp. Normally this option is not needed, and the more efficient
 C<limit_glob> attribute is used instead.
 
-
 =item $search->dir_prefix( I<some-string-value> );
 
 Setting this attribute to a string value means that the searches should

t/search22.t

@@ -121,7 +121,7 @@ skip $^O eq 'VMS' ? '-- case may or may not be preserved' : 0,
     '/testlib2/';
 
 my $in_pods = $x->find('perlzoned', $here2);
-ok $in_pods, qr{^$here2};
+ok $in_pods, qr{^\Q$here2\E};
 ok $in_pods, qr{perlzoned.pod$};
 
 print "# OK, bye from ", __FILE__, "\n";

t/search60.t

@@ -0,0 +1,56 @@
+BEGIN {
+    if($ENV{PERL_CORE}) {
+        chdir 't';
+        @INC = '../lib';
+    }
+}
+
+use strict;
+use Pod::Simple::Search;
+use Test;
+BEGIN { plan tests => 4 }
+
+print "# ", __FILE__,
+ ": Testing forced case sensitivity ...\n";
+
+my $x = Pod::Simple::Search->new;
+die "Couldn't make an object!?" unless ok defined $x;
+
+$x->inc(0);
+$x->is_case_insensitive(0);
+
+use File::Spec;
+use Cwd;
+my $cwd = cwd();
+print "# CWD: $cwd\n";
+
+sub source_path {
+    my $file = shift;
+    if ($ENV{PERL_CORE}) {
+        my $updir = File::Spec->updir;
+        my $dir = File::Spec->catdir($updir, 'lib', 'Pod', 'Simple', 't');
+        return File::Spec->catdir ($dir, $file);
+    } else {
+        return $file;
+    }
+}
+
+my($A, $B);
+
+if(        -e ($A = source_path(  'search60/A'      ))) {
+  die "But where's $B?"
+    unless -e ($B = source_path(  'search60/B'));
+} elsif(   -e ($A = File::Spec->catdir($cwd, 't', 'search60', 'A'      ))) {
+  die "But where's $B?"
+    unless -e ($B = File::Spec->catdir($cwd, 't', 'search60', 'B'));
+} else {
+  die "Can't find the test corpora";
+}
+print "# OK, found the test corpora\n#  as $A\n# and $B\n#\n";
+ok 1;
+
+my($name2where, $where2name) = $x->survey($A, $B);
+
+ok ($name2where->{x} =~ m{^\Q$A\E[\\/]x\.pod$});
+
+ok ($name2where->{X} =~ m{^\Q$B\E[\\/]X\.pod$});

t/search60/A/x.pod

@@ -0,0 +1 @@
+=head1 x

t/search60/B/X.pod

@@ -0,0 +1 @@
+=head1 X