package Plack::App::Directory::Apaxy; { $Plack::App::Directory::Apaxy::VERSION = '0.004'; } # ABSTRACT: Serve static files from document root with directory index using Apaxy use parent qw(Plack::App::Directory); use strict; use warnings; use Plack::MIME; use Plack::Util; use Number::Bytes::Human; use Path::Tiny; use Time::Piece; use URI::Escape; use Plack::Util::Accessor qw( apaxy_root below footer ); our %MIME_TYPE_TO_ALT = ( "application/atom+xml" => q{rss}, "application/font-woff" => q{default}, "application/java-archive" => q{java}, "application/javascript" => q{js}, "application/json" => q{json}, "application/mathml+xml" => q{xml}, "application/mbox" => q{default}, "application/msword" => q{doc}, "application/octet-stream" => q{bin}, "application/ogg" => q{audio}, "application/pdf" => q{pdf}, "application/pgp-encrypted" => q{default}, "application/pgp-signature" => q{default}, "application/postscript" => q{ps}, "application/rdf+xml" => q{xml}, "application/rss+xml" => q{rss}, "application/rtf" => q{rtf}, "application/vnd.ms-cab-compressed" => q{archive}, "application/vnd.ms-excel" => q{doc}, "application/vnd.ms-htmlhelp" => q{doc}, "application/vnd.ms-powerpoint" => q{doc}, "application/vnd.oasis.opendocument.presentation" => q{doc}, "application/vnd.oasis.opendocument.spreadsheet" => q{doc}, "application/vnd.oasis.opendocument.text" => q{doc}, "application/wsdl+xml" => q{xml}, "application/x-bittorrent" => q{default}, "application/x-bzip-compressed-tar" => q{gzip}, "application/x-bzip2" => q{gzip}, "application/x-debian-package" => q{debian}, "application/x-dvi" => q{default}, "application/x-gzip" => q{gzip}, "application/x-java-jnlp-file" => q{java}, "application/x-msdownload" => q{default}, "application/x-rar-compressed" => q{rar}, "application/x-redhat-package-manager" => q{rpm}, "application/x-sh" => q{script}, "application/x-shockwave-flash" => q{default}, "application/x-tar" => q{tar}, "application/x-tcl" => q{script}, "application/x-tex" => q{tex}, "application/x-texinfo" => q{tex}, "application/x-x509-ca-cert" => q{default}, "application/xhtml+xml" => q{xml}, "application/xml" => q{xml}, "application/xml-dtd" => q{xml}, "application/xslt+xml" => q{xml}, "application/zip" => q{zip}, "audio/basic" => q{audio}, "audio/midi" => q{audio}, "audio/mpeg" => q{audio}, "audio/x-aiff" => q{audio}, "audio/x-mpegurl" => q{audio}, "audio/x-ms-wma" => q{audio}, "audio/x-pn-realaudio" => q{audio}, "audio/x-wav" => q{audio}, "image/bmp" => q{bmp}, "image/gif" => q{gif}, "image/jpeg" => q{jpg}, "image/png" => q{png}, "image/svg+xml" => q{image}, "image/tiff" => q{tiff}, "image/vnd.adobe.photoshop" => q{psd}, "image/vnd.djvu" => q{image}, "image/vnd.microsoft.icon" => q{image}, "image/x-portable-anymap" => q{image}, "image/x-portable-bitmap" => q{image}, "image/x-portable-graymap" => q{image}, "image/x-portable-pixmap" => q{image}, "image/x-xbitmap" => q{image}, "image/x-xpixmap" => q{image}, "message/rfc822" => q{default}, "model/vrml" => q{default}, "text/cache-manifest" => q{text}, "text/calendar" => q{text}, "text/css" => q{css}, "text/csv" => q{text}, "text/html" => q{html}, "text/plain" => q{text}, "text/sgml" => q{text}, "text/troff" => q{text}, "text/x-asm" => q{text}, "text/x-c" => q{c}, "text/x-diff" => q{diff}, "text/x-fortran" => q{text}, "text/x-java-source" => q{java}, "text/x-pascal" => q{text}, "text/x-script.perl" => q{perl}, "text/x-script.perl-module" => q{perl}, "text/x-script.python" => q{py}, "text/x-script.ruby" => q{rb}, "text/x-vcalendar" => q{vcal}, "text/x-vcard" => q{text}, "text/yaml" => q{text}, "video/3gpp" => q{video}, "video/mp4" => q{video}, "video/mpeg" => q{video}, "video/ogg" => q{video}, "video/quicktime" => q{video}, "video/x-flv" => q{video}, "video/x-mng" => q{video}, "video/x-ms-asf" => q{video}, "video/x-ms-wmv" => q{video}, "video/x-ms-wmx" => q{video}, "video/x-msvideo" => q{video}, ); my $dir_file = q{ [%s] %s %s %s }; sub _get_dir_page_fmt { my $self = shift; my $dir_page = <<"END_PAGE"; %s

%s

%s
[ICO] Name Last modified Size
@{[ $self->below ]}
END_PAGE return $dir_page; } sub prepare_app { my $self = shift; $self->below(q{}) unless defined $self->below; $self->footer(<<'END_TEXT') unless defined $self->footer; Plack::App::Directory::Apaxy is proudly made with Apaxy, Plack & Perl. END_TEXT unless ( $self->apaxy_root ) { $self->apaxy_root( path(__FILE__)->parent->child(qw/ Apaxy public /) ); } } # Stolen from Plack::App::File (Plack version 1.0030) sub call { my $self = shift; my $env = shift; my ( $file, $path_info ) = $self->file; if ( !$file ) { ( $file, $path_info ) = $self->locate_file($env); if ( ref $file eq 'ARRAY' ) { return $file unless $file->[0] == 404; ( $file, $path_info ) = $self->locate_apaxy($env); return $file if ref $file eq 'ARRAY'; } } if ($path_info) { $env->{'plack.file.SCRIPT_NAME'} = $env->{SCRIPT_NAME} . $env->{PATH_INFO}; $env->{'plack.file.SCRIPT_NAME'} =~ s/\Q$path_info\E$//; $env->{'plack.file.PATH_INFO'} = $path_info; } else { $env->{'plack.file.SCRIPT_NAME'} = $env->{SCRIPT_NAME} . $env->{PATH_INFO}; $env->{'plack.file.PATH_INFO'} = q{}; } return $self->serve_path( $env, $file ); } # Stolen from Plack::App::File (Plack version 1.0030) sub locate_apaxy { my ( $self, $env ) = @_; my $path = $env->{PATH_INFO} || q{}; return $self->return_400 if $path =~ m{\0}; return $self->return_404 unless $path =~ m{^(/_apaxy/|/favicon.ico$)}; my $docroot = $self->apaxy_root; my @path = split /[\\\/]/, $path; if (@path) { shift @path if $path[0] eq q{}; } else { @path = (q{.}); } return $self->return_403 if grep $_ eq q{..}, @path; my $file = path( $docroot, @path ); return $self->return_404 unless $self->should_handle($file); return $self->return_403 unless -r $file; return $file, join( q{/}, q{}, @path ); } # Stolen from Plack::App::Directory (Plack version 1.0030) sub serve_path { my ( $self, $env, $dir ) = @_; return $self->SUPER::serve_path( $env, $dir ) if -f $dir; if ( $dir =~ m{^(/_apaxy/|/favicon.ico$)} ) { my $docroot = $self->apaxy_root; my $file = path( $docroot, $dir ); return $self->SUPER::serve_path( $env, $file ) if -f $file; } my $dir_url = $env->{SCRIPT_NAME} . $env->{PATH_INFO}; return $self->return_dir_redirect($env) if $dir_url !~ m{/$}; my @files = ([ q{folder-home}, q{DIR}, q{../}, q{Parent Directory}, q{}, q{-}, ]); # # sort using C/O/D/H # my $req = Plack::Request->new($env); my $category = $req->param('C') || q{N}; my $order = $req->param('O') || q{A}; my $dir_first = $req->param('D') || q{Y}; my $hide = $req->param('H') || q{Y}; my @children; if ( $hide eq 'Y' ) { @children = map +{ path => $_, stat => $_->stat, is_dir => -d _ }, grep { $_->basename !~ /^\./ } path($dir)->children; } else { @children = map +{ path => $_, stat => $_->stat, is_dir => -d _ }, path($dir)->children; } if ( $dir_first eq 'Y' ) { if ( $order eq 'A' ) { if ( $category eq 'M' ) { @children = sort { $b->{is_dir} <=> $a->{is_dir} or $a->{stat}->mtime <=> $b->{stat}->mtime } @children; } elsif ( $category eq 'N' ) { @children = sort { $b->{is_dir} <=> $a->{is_dir} or $a->{path} cmp $b->{path} } @children; } elsif ( $category eq 'S' ) { @children = sort { $b->{is_dir} <=> $a->{is_dir} or $a->{stat}->size <=> $b->{stat}->size } @children; } } elsif ( $order eq 'D' ) { if ( $category eq 'M' ) { @children = sort { $b->{is_dir} <=> $a->{is_dir} or $b->{stat}->mtime <=> $a->{stat}->mtime } @children; } elsif ( $category eq 'N' ) { @children = sort { $b->{is_dir} <=> $a->{is_dir} or $b->{path} cmp $a->{path} } @children; } elsif ( $category eq 'S' ) { @children = sort { $b->{is_dir} <=> $a->{is_dir} or $b->{stat}->size <=> $a->{stat}->size } @children; } } } else { if ( $order eq 'A' ) { if ( $category eq 'M' ) { @children = sort { $a->{stat}->mtime <=> $b->{stat}->mtime } @children; } elsif ( $category eq 'N' ) { @children = sort { $a->{path} cmp $b->{path} } @children; } elsif ( $category eq 'S' ) { @children = sort { $a->{stat}->size <=> $b->{stat}->size } @children; } } elsif ( $order eq 'D' ) { if ( $category eq 'M' ) { @children = reverse sort { $a->{stat}->mtime <=> $b->{stat}->mtime } @children; } elsif ( $category eq 'N' ) { @children = reverse sort { $a->{path} cmp $b->{path} } @children; } elsif ( $category eq 'S' ) { @children = reverse sort { $a->{stat}->size <=> $b->{stat}->size } @children; } } } for my $child (@children) { my $file = $child->{path}; my $stat = $child->{stat}; my $basename = $file->basename; my $url = join '/', map { uri_escape($_) } split m{/}, $dir_url . $basename; my $mime_type; my $alt; my $icon; my $size; if ( $file->is_dir ) { $basename .= "/"; $url .= "/"; $mime_type = q{directory}; $alt = q{DIR}; $icon = q{folder}; $size = q{-}; } else { $mime_type = Plack::MIME->mime_type($file) || 'text/plain'; $alt = uc $MIME_TYPE_TO_ALT{$mime_type} || q{ }; $icon = $MIME_TYPE_TO_ALT{$mime_type} || 'default'; $size = Number::Bytes::Human::format_bytes( $stat->size ); } my $dt = localtime $stat->mtime; push @files, [ $icon, $alt, $url, $basename, sprintf( '%s %02d:%02d', $dt->ymd, $dt->hour, $dt->minute ), $size, ]; } my $path = Plack::Util::encode_html("Index of $env->{PATH_INFO}"); my $files = join "\n", map { my $f = $_; sprintf q{ } x 8 . $dir_file, map Plack::Util::encode_html($_), @$f; } @files; my $page = sprintf $self->_get_dir_page_fmt, $path, $path, $files; return [ 200, [ 'Content-Type' => 'text/html; charset=utf-8' ], [$page] ]; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Plack::App::Directory::Apaxy - Serve static files from document root with directory index using Apaxy =head1 VERSION version 0.004 =head1 SYNOPSIS # app.psgi use Plack::App::Directory::Apaxy; my $app = Plack::App::Directory->new({ root => "/path/to/htdocs" })->to_app; # one-liner $ plackup -MPlack::App::Directory::Apaxy -e 'Plack::App::Directory::Apaxy->new->to_app' # one-liner using Starlet $ plackup -s Starlet -MPlack::App::Directory::Apaxy --max-workers=5 -e 'Plack::App::Directory::Apaxy->new->to_app' =head1 DESCRIPTION This is a static file server PSGI application with directory index using Apaxy. =head1 ATTRIBUTES =head2 root Document root directory. Defaults to the current directory. =head2 apaxy_root Apaxy resource root directory. Usually you don't need to set it up by your hand. =head2 below HTML contents what you want to insert to index page. =head2 footer HTML contents what you want to insert to index page. =head1 SEE ALSO =over 4 =item * L =item * L =back =head1 AUTHOR Keedi Kim - κΉ€λ„ν˜• =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Keedi Kim. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut