view release on metacpan or  search on metacpan

lib/Plack/Middleware/DirListing.pm  view on Meta::CPAN

  </tr>
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