File Coverage

lib/Plack/Middleware/DirListing.pm

Criterion	Covered	Total	%
statement	102	105	97.1
branch	16	24	66.6
condition	8	9	88.8
subroutine	20	20	100.0
pod	2	9	22.2
total	148	167	88.6

package Plack::Middleware::DirListing;
# ABSTRACT: Display a directory listing if no default index html page

use parent qw( Plack::Middleware );
use DirHandle;
use HTML::Entities;
use Plack::Request;
use Plack::MIME;
use Plack::Util::Accessor qw( root );
use URI::Escape;
use Time::Piece;

use strict;
use warnings;
use v5.10;

sub dir_html {

  state $html = do {
    local $/ = undef;
    my $data_string = ;
    close DATA;

    $data_string =~ s/%(?!s)/%%/g;
    $data_string;
   };

  return $html;
}

sub file_html {
  return <







FILE
}

sub last_modified {
  my ($self, $date) = @_;

  return Time::Piece->new( $date )->strftime( "%d-%b-%Y %H:%M" );
 }

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

  if (my ($field, $order) = $env->{ QUERY_STRING } =~ /C=(\w);O=(\w)/) {
    my $invert = ($order eq 'A') ? 'D' : 'A';
    $page =~ s/C=$field;O=$order/C=$field;O=$invert/;
   }

  return $page;
 }

my %col_sort = (
	'NA' => sub { $a->[2] cmp $b->[2] },
	'ND' => sub { $b->[2] cmp $a->[2] },
	'MA' => sub { $a->[6] <=> $b->[6] },
	'MD' => sub { $b->[6] <=> $a->[6] },
	'SA' => sub { $a->[4] <=> $b->[4] },
	'SD' => sub { $b->[4] <=> $a->[4] },
	'DA' => sub { $a->[5] cmp $b->[5] },
	'DD' => sub { $b->[5] cmp $a->[5] },
);

sub filetype_class {
  my ($self, $filetype) = @_;

  return 'ft_directory' if ($filetype eq 'directory');
  return 'ft_image' if ($filetype =~ /^image/);
  return 'ft_pdf' if ($filetype =~ /pdf$/);
  return 'ft_html' if ($filetype =~ /html$/);

  return '';
}


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

  my @files;

  my $dh = DirHandle->new($dir);

  while (defined(my $ent = $dh->read)) {
    next if $ent eq '.' or $ent eq '..';

    my $file = "$dir/$ent";
    my $url = $env->{PATH_INFO} . $ent;

    my $is_dir = -d $file;
    my @stat = stat _;

    $url = join '/', map {uri_escape($_)} split m{/}, $url;

    if ($is_dir) {
      $ent .= "/";
      $url .= "/";
    }

    my $mime_type = $is_dir ? 'directory' : ( Plack::MIME->mime_type($file) || 'text/plain' );
    my $filetype_class = $self->filetype_class( $mime_type );
    push @files, [ $filetype_class, $url, $ent, $self->last_modified( $stat[9] ), $stat[7], $mime_type, $stat[9] ];
  }

  my ($field, $order) = $env->{ QUERY_STRING } =~ /C=(\w);O=(\w)/;
  $field ||= 'N';
  $order ||= 'A';

  @files = sort { &{ $col_sort{ "$field$order" } } } @files;

  return [ [ 'ft_parent', "../", "Parent Directory", '', '', '', 0], @files ];
}

sub prepare_app {
    my ($self) = @_;

    $self->root('.')               unless $self->root;
}

# NOTE: Copied from Plack::App::Directory as that module makes it
# impossible to override the HTML.

sub serve_path {
  my $self = shift;
  my ($env, $dir) = @_;

  my $files = $self->read_dir( $env, $dir );

  my $path  = Plack::Util::encode_html("Index of $env->{PATH_INFO}");
  my $files_html = join "\n", map {
    my $f = $_;
    sprintf $self->file_html, map Plack::Util::encode_html($_), @{ $f }[ 0..5 ];
  } @{ $files };
  my $page  = sprintf $self->dir_html, $path, $path, $files_html, $env->{ HTTP_HOST };

  $page = $self->sort_order( $env, $page );

  return [ 200, ['Content-Type' => 'text/html; charset=utf-8'], [ $page ] ];
}

sub call {
    my ( $self, $env ) = @_;
    my $req = Plack::Request->new( $env );

    my $dir = $self->root . $req->path_info();
    if (-d $dir) {
        if (substr( $dir, -1 ) eq '/') {
          return $self->serve_path( $env, $dir );
         }
        else {
          my $uri = $req->uri();
          $uri->path( $uri->path . '/' );
          my $res = $req->new_response(301); # new Plack::Response
          $res->headers([
			'Location' => $uri,
			'Content-Type' => 'text/html; charset=UTF-8',
			'Cache-Control' => 'must-revalidate, max-age=3600'
			]);

          my $uhe = encode_entities($uri);
          $res->body( <
301 Moved PermanentlyMoved PermanentlyThe document has moved here.
REDIRECT_BODY

          return $res->finalize;
         }
    }

    return $self->app->($env);
}

=head1 NAME

Plack::Middleware::DirListing - Display a listing of a directory in html

=head1 SYNOPSIS

  use Plack::Builder;
  use Plack::App::File;

  my $app = Plack::App::File->new({ root => '.' })->to_app;

  builder {
        enable "DirListing", root => '.';
        $app;
  }

=head1 DESCRIPTION

This Plack middleware provides the same functionality as L, but *only* serves the directory listing if the URL points to a directory. It does not try to serve any files.

It also strives to have a cleaner UI that more closely matches a prettified version of the Apache web server's output.

This modules does not attempt to find a default html file for the directory. If desired, include L or L before this module.

=head1 CONFIGURATION

=over 4

=item root

Document root directory. Defaults to the current directory.

=back

=head1 AUTHOR

Keith Carangelo

=cut

1;

__DATA__