File Coverage

blib/lib/WebServer/DirIndex.pm

Criterion	Covered	Total	%
statement	33	33	100.0
branch			n/a
condition			n/a
subroutine	11	11	100.0
pod			n/a
total	44	44	100.0

use strict;
use warnings;
use Feature::Compat::Class;
use WebServer::DirIndex::HTML;

class WebServer::DirIndex v0.1.0 {

  use Path::Tiny;
  use HTTP::Date;
  use HTML::Escape qw(escape_html);
  use MIME::Types;
  use URI::Escape;
  use WebServer::DirIndex::CSS;
  use WebServer::DirIndex::File;

  my $mime_types = MIME::Types->new;

  field $dir        :param;
  field $dir_url    :param;
  field $icons      :param = undef;
  field $pretty     :param = 0;
  field $html_class :param = 'WebServer::DirIndex::HTML';
  field $css_class  :param = 'WebServer::DirIndex::CSS';
  field $_html_obj;
  field $_css_obj;
  field @files;

  ADJUST {
    $icons = 1 if !defined($icons) && $pretty;  # pretty implies icons when unset
    $icons //= 1;                                 # default to enabled otherwise
    $_html_obj = $html_class->new(icons => $icons);
    $_css_obj  = $css_class->new(pretty => $pretty);
    @files = ( WebServer::DirIndex::File->parent_dir(
      html_class => $html_class,
      icons      => $icons,
    ) );

    my @children = map { $_->basename } path($dir)->children;

    for my $basename (sort { $a cmp $b } @children) {
      my $file = "$dir/$basename";
      my $url  = $dir_url . $basename;

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

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

      if ($is_dir) {
        $basename .= '/';
        $url      .= '/';
      }

      my $type_obj  = $is_dir ? undef : $mime_types->mimeTypeOf($file);
      my $mime_type = $is_dir
        ? 'directory'
        : ($type_obj ? $type_obj->type : 'text/plain');

      push @files, WebServer::DirIndex::File->new(
        url        => $url,
        name       => $basename,
        size       => $stat[7],
        mime_type  => $mime_type,
        mtime      => HTTP::Date::time2str($stat[9]),
        html_class => $html_class,
        icons      => $icons,
      );
    }
  }

  method files { return @files }

  method to_html ($path_info) {
    my $path = escape_html("Index of $path_info");
    my $files_html = join "\n", map { $_->to_html } @files;
    my $css = $_css_obj->css;
    return sprintf $_html_obj->dir_html, $path, $css, $path, $files_html;
  }
}

1;

__END__