File Coverage

blib/lib/Plack/App/File/CaseInsensitive.pm

Criterion	Covered	Total	%
statement	47	54	87.0
branch	13	24	54.1
condition	7	13	53.8
subroutine	8	8	100.0
pod	0	1	0.0
total	75	100	75.0

package Plack::App::File::CaseInsensitive;
{
  $Plack::App::File::CaseInsensitive::VERSION = '0.001000';
}

# ABSTRACT: Serve static files with case insensitive paths

use strict;
use warnings;

use base 'Plack::App::File';

use mro 'c3';
use File::Find;

sub locate_file {
   my ($self, $env) = @_;

   {
      my ($file, $path_info) = $self->next::method($env);

      return ($file, $path_info)
         unless ref $file && ref $file eq 'ARRAY' && $file->[0] == 404;
   }

   warn "Case insensitive mode!  Beware performance problems! ($env->{PATH_INFO})";

    # the rest of this is more or less copied verbatim from the base class
    my $path = $env->{PATH_INFO} || '';

    if ($path =~ /\0/) {
        return $self->return_400;
    }

    my $docroot = $self->root || ".";
    my @path = split /[\\\/]/, $path;
    if (@path) {
        shift @path if $path[0] eq '';
    } else {
        @path = ('.');
    }

    if (grep $_ eq '..', @path) {
        return $self->return_403;
    }

    my ($file, @path_info);
    OUTER:
    while (@path) {
        for my $try ($self->_find_file($docroot, @path)) {
           if ($self->should_handle($try)) {
               $file = $try;
               last OUTER;
           } elsif (!$self->allow_path_info) {
               last OUTER;
           }
        }
        unshift @path_info, pop @path;
    }

    if (!$file) {
        return $self->return_404;
    }

    if (!-r $file) {
        return $self->return_403;
    }

    return $file, join("/", "", @path_info);
}

sub _find_file {
   my ($self, $docroot, @path) = @_;

   my $full_path = join '/', $docroot, @path;
   my $re = qr/\Q$full_path\E/i;

   my @files;
   find(sub {
      if(-d $File::Find::name && $full_path !~ /^\Q$File::Find::name/i) {
         $File::Find::prune = 1;
         return;
      }
      push @files, $File::Find::name
         if $File::Find::name =~ $re
   }, $docroot);

   warn "multiple files found!" if @files > 1;

   return @files;
}

1;

__END__