package Mojolicious::Plugin::Directory; use strict; use warnings; our $VERSION = '0.07'; use Cwd (); use Encode (); use DirHandle; use Mojo::Base qw{ Mojolicious::Plugin }; use Mojolicious::Types; # Stolen from Plack::App::Direcotry my $dir_page = <<'PAGE'; Index of <%= $cur_path %>

Index of <%= $cur_path %>


% for my $file (@$files) { % }
Name Size Type Last Modified
<%== $file->{name} %><%= $file->{size} %><%= $file->{type} %><%= $file->{mtime} %>

PAGE my $types = Mojolicious::Types->new; sub register { my $self = shift; my ( $app, $args ) = @_; my $root = Mojo::Home->new( $args->{root} || Cwd::getcwd ); my $handler = $args->{handler}; my $index = $args->{dir_index}; $dir_page = $args->{dir_page} if ( $args->{dir_page} ); $app->hook( before_dispatch => sub { my $c = shift; return render_file( $c, $root ) if ( -f $root->to_string() ); given ( my $path = $root->rel_dir( Mojo::Util::url_unescape( $c->req->url->path ) ) ) { $handler->( $c, $path ) if ( ref $handler eq 'CODE' ); when (-f) { render_file( $c, $path ) unless ( $c->tx->res->code ) } when (-d) { if ( $index && ( my $file = locate_index( $index, $path ) ) ) { return render_file( $c, $file ); } render_indexes( $c, $path ) unless ( $c->tx->res->code ) } default {} } }, ); return $app; } sub locate_index { my $index = shift || return; my $dir = shift || Cwd::getcwd; my $root = Mojo::Home->new($dir); $index = ( ref $index eq 'ARRAY' ) ? $index : ["$index"]; for (@$index) { my $path = $root->rel_file($_); return $path if ( -e $path ); } } sub render_file { my $c = shift; my $file = shift; my $data = Mojo::Util::slurp($file); $c->render( data => $data, format => get_ext($file) || 'txt' ); } sub render_indexes { my $c = shift; my $dir = shift; my @files = ( $c->req->url eq '/' ) ? () : ( { url => '../', name => 'Parent Directory', size => '', type => '', mtime => '' } ); my $children = list_files($dir); my $cur_path = Encode::decode_utf8( Mojo::Util::url_unescape( $c->req->url->path ) ); for my $basename ( sort { $a cmp $b } @$children ) { my $file = "$dir/$basename"; my $url = Mojo::Path->new($cur_path)->trailing_slash(0); push @{ $url->parts }, $basename; my $is_dir = -d $file; my @stat = stat _; if ($is_dir) { $basename .= '/'; $url->trailing_slash(1); } my $mime_type = $is_dir ? 'directory' : ( $types->type( get_ext($file) || 'txt' ) || 'text/plain' ); my $mtime = Mojo::Date->new( $stat[9] )->to_string(); push @files, { url => $url, name => $basename, size => $stat[7] || 0, type => $mime_type, mtime => $mtime, }; } $c->render( inline => $dir_page, files => \@files, cur_path => $cur_path ); } sub get_ext { $_[0] =~ /\.([0-9a-zA-Z]+)$/ || return; return lc $1; } sub list_files { my $dir = shift || return []; my $dh = DirHandle->new($dir); my @children; while ( defined( my $ent = $dh->read ) ) { next if $ent eq '.' or $ent eq '..'; push @children, Encode::decode_utf8($ent); } return [ @children ]; } 1; __END__ =head1 NAME Mojolicious::Plugin::Directory - Serve static files from document root with directory index =head1 SYNOPSIS # simple usage use Mojolicious::Lite; plugin( 'Directory', root => "/path/to/htdocs" )->start; # with handler use Text::Markdown qw{ markdown }; use Path::Class; use Encode qw{ decode_utf8 }; plugin('Directory', root => "/path/to/htdocs", handler => sub { my ($c, $path) = @_; if ( -f $path && $path =~ /\.(md|mkdn)$/ ) { my $text = file($path)->slurp; my $html = markdown( decode_utf8($text) ); $c->render( inline => $html ); } })->start; or > perl -Mojo -E 'a->plugin("Directory", root => "/path/to/htdocs")->start' daemon =head1 DESCRIPTION L is a static file server directory index a la Apache's mod_autoindex. =head1 METHODS L inherits all methods from L. =head1 OPTIONS L supports the following options. =head2 C # Mojolicious::Lite plugin Directory => { root => "/path/to/htdocs" }; Document root directory. Defaults to the current directory. if root is a file, serve only root file. =head2 C # Mojolicious::Lite plugin Directory => { dir_index => [qw/index.html index.htm/] }; like a Apache's DirectoryIndex directive. =head2 C # Mojolicious::Lite plugin Directory => { dir_page => $template_str }; a HTML template of index page =head2 C # Mojolicious::Lite use Text::Markdown qw{ markdown }; use Path::Class; use Encode qw{ decode_utf8 }; plugin Directory => { handler => sub { my ($c, $path) = @_; if ($path =~ /\.(md|mkdn)$/) { my $text = file($path)->slurp; my $html = markdown( decode_utf8($text) ); $c->render( inline => $html ); } } }; CODEREF for handle a request file. if not rendered in CODEREF, serve as static file. =head1 AUTHOR hayajo Ehayajo@cpan.orgE =head1 SEE ALSO L =head1 LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut