view release on metacpan or  search on metacpan

lib/WebServer/DirIndex.pm  view on Meta::CPAN

package WebServer::DirIndex; # For cpanm :-(

use strict;
use warnings;
use Feature::Compat::Class;

our $VERSION = '0.1.4';

class WebServer::DirIndex {

  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;
  use WebServer::DirIndex::HTML;

  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__

=head1 NAME

WebServer::DirIndex - Directory index data for web server listings

=head1 SYNOPSIS

  use WebServer::DirIndex;

  my $di = WebServer::DirIndex->new(
    dir     => '/path/to/dir',
    dir_url => '/some/dir/',
    icons   => 1,          # optional, defaults to 1 (enabled)
    pretty  => 0,          # optional, defaults to 0 (standard CSS)
  );

  # Get the list of file entries
  my @files = $di->files;

  # Generate an HTML directory index page
  my $html = $di->to_html('/some/dir/');

=head1 DESCRIPTION