File Coverage

blib/lib/WebServer/DirIndex/File.pm

Criterion	Covered	Total	%
statement	21	22	95.4
branch	4	4	100.0
condition			n/a
subroutine	7	7	100.0
pod	1	1	100.0
total	33	34	97.0

package WebServer::DirIndex::File; # For cpanm

our $VERSION = '0.1.4';

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

class WebServer::DirIndex::File {

  use HTML::Escape qw(escape_html);

  my %ICON_MAP = (
    'directory'                                                                    => 'fa-solid fa-folder',
    ''                                                                             => 'fa-solid fa-arrow-up',
    'text/plain'                                                                   => 'fa-solid fa-file-lines',
    'text/html'                                                                    => 'fa-solid fa-file-code',
    'text/css'                                                                     => 'fa-solid fa-file-code',
    'text/csv'                                                                     => 'fa-solid fa-file-csv',
    'text/javascript'                                                              => 'fa-solid fa-file-code',
    'application/pdf'                                                              => 'fa-solid fa-file-pdf',
    'application/msword'                                                           => 'fa-solid fa-file-word',
    'application/vnd.openxmlformats-officedocument.wordprocessingml.document'     => 'fa-solid fa-file-word',
    'application/vnd.ms-excel'                                                     => 'fa-solid fa-file-excel',
    'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet'           => 'fa-solid fa-file-excel',
    'application/vnd.ms-powerpoint'                                                => 'fa-solid fa-file-powerpoint',
    'application/vnd.openxmlformats-officedocument.presentationml.presentation'   => 'fa-solid fa-file-powerpoint',
    'application/javascript'                                                       => 'fa-solid fa-file-code',
    'application/json'                                                             => 'fa-solid fa-file-code',
    'application/xml'                                                              => 'fa-solid fa-file-code',
    'application/zip'                                                              => 'fa-solid fa-file-zipper',
    'application/x-tar'                                                            => 'fa-solid fa-file-zipper',
    'application/gzip'                                                             => 'fa-solid fa-file-zipper',
    'application/x-bzip2'                                                          => 'fa-solid fa-file-zipper',
    'application/x-rar-compressed'                                                 => 'fa-solid fa-file-zipper',
  );

  my %ICON_PREFIX_MAP = (
    'image/' => 'fa-solid fa-file-image',
    'audio/' => 'fa-solid fa-file-audio',
    'video/' => 'fa-solid fa-file-video',
    'text/'  => 'fa-solid fa-file-lines',
  );

  sub _icon_class {
    my ($mime_type) = @_;
    return $ICON_MAP{$mime_type} if exists $ICON_MAP{$mime_type};
    for my $prefix (keys %ICON_PREFIX_MAP) {
      return $ICON_PREFIX_MAP{$prefix} if index($mime_type, $prefix) == 0;
    }
    return 'fa-solid fa-file';
  }

  field $url        :param :reader;
  field $name       :param :reader;
  field $size       :param :reader;
  field $mime_type  :param :reader;
  field $mtime      :param :reader;
  field $icon       :param :reader = undef;
  field $icons      :param = 0;
  field $html_class :param = 'WebServer::DirIndex::HTML';
  field $_html_obj = $html_class->new(icons => $icons);

  ADJUST {
    if ($icons && !defined $icon) {
      $icon = _icon_class($mime_type);
    }
  }

  method to_html {
    if (defined $icon) {
      return sprintf $_html_obj->file_html_icons,
        map { escape_html($_) }
          ($icon, $url, $name, $size, $mime_type, $mtime);
    }
    return sprintf $_html_obj->file_html,
      map { escape_html($_) }
        ($url, $name, $size, $mime_type, $mtime);
  }

  sub parent_dir {
    my ($class, %args) = @_;
    return WebServer::DirIndex::File->new(
      url       => '../',
      name      => 'Parent Directory',
      size      => '',
      mime_type => '',
      mtime     => '',
      %args,
    );
  }
}

1;

__END__