File Coverage

blib/lib/Dancer/Plugin/DirectoryView.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package Dancer::Plugin::DirectoryView;

=head1 NAME

Dancer::Plugin::DirectoryView - Browse directory contents in Dancer web apps

=cut

use strict;

use Cwd 'abs_path';
use Dancer ':syntax';
use Dancer::Engine;
use Dancer::MIME;
use Dancer::Plugin;
use DirHandle;
use File::ShareDir;
use File::Spec::Functions qw(catfile);
use HTTP::Date;
use URI::Escape;

our $VERSION = '0.02';

# Distribution-level shared data directory
my $dist_dir = File::ShareDir::dist_dir('Dancer-Plugin-DirectoryView');

my $settings = plugin_setting;
my $path_prefix = $settings->{path_prefix} || '/dancer-directory-view';
# Need a leading slash
if ($path_prefix !~ m!^/!) {
    $path_prefix = '/' . $path_prefix;
}

my $mime = Dancer::MIME->instance();

my $builtin_tpl = {};

sub directory_view {
    my $options;

    if (@_ == 1 || (@_ == 2 && UNIVERSAL::isa($_[1], 'HASH'))) {
        #
        # Called from the application
        #
        my ($root_url, $options) = @_;

        my $root_dir = $options->{root_dir};

        # Public directory
        my $public_dir = abs_path(setting('public'));

        if (defined $root_dir) {
            # Root directory is set explicitly -- is it an absolute path?
            if (!File::Spec->file_name_is_absolute($root_dir)) {
                # No -- we assume it's relative to the public directory
                $root_dir = abs_path(catfile($public_dir, $root_dir));
            }
        }
        else {
            # Root directory not set -- assume it's the same as root URL,
            # relative to the public directory
            $root_dir = catfile($public_dir, split('/', $root_url));
        }

        $options->{root_dir} = $root_dir;

        my $re_root = quotemeta($root_url);

        # Does the root URL have a trailing slash?
        if ($root_url !~ m!/$!) {
            # Add slash
            $root_url =~ s!([^/])$!$1/!;

            # Add a redirection route
            get qr{$re_root} => sub {
                redirect $root_url;
            };
        }

        my $re_path = quotemeta($root_url) . '(.*)';

        get qr{$re_path} => sub {
            my ($path) = splat;

            return directory_view(%$options, path => $path);
        };
    }
    else {
        #
        # Called from a route handler
        #
        return _serve_files(@_);
    }
}

sub _serve_files {
    my (%options) = @_;

    # Root directory
    my $root_dir = $options{root_dir} || '.';
    # Are system paths allowed?
    my $system_path = $options{system_path} || 0;
    # Template to use (if set to 0, a primitive built-in template is used)
    my $template = $options{template} || 'basic';
    # Should hidden files be included in the directory listing?
    my $show_hidden_files = $options{show_hidden_files} || 0;

    # Current path
    my $path = $options{path};

    # Views directory
    my $views_dir = abs_path(setting('views'));

    # Strip off unwanted leading/trailing slashes
    $root_dir =~ s!/$!!;
    $path =~ s!^/!!;

    # If root_dir is not absolute, assume it is relative to public directory
    if (!File::Spec->file_name_is_absolute($root_dir)) {
        $root_dir = abs_path(catfile(abs_path(setting('public')), $root_dir));
    }

    my $real_path = abs_path(catfile($root_dir, $path));
    $real_path =~ s!/$!!;

    if (index($real_path, abs_path(setting('public'))) != 0 && !$system_path) {
        # The requested file/directory lies outside of the public directory, but
        # system paths are not allowed
        return send_error("Not allowed", 403);
    }

    # Make sure we're inside root_dir. This shouldn't actually be necessary, as
    # Dancer takes care of potentially dangerous paths (e.g., containing "..")
    # and we should be safe at this point, but let's do the check anyway in case
    # the application is deployed in some weird insecure way or something.
    if (index($real_path, $root_dir) != 0) {
        return send_error("Not allowed", 403);
    }

    if (-f $real_path) {
        #
        # Regular file
        #
        send_file($real_path, system_path => $system_path);
    }
    elsif (-d $real_path) {
        #
        # Directory -- show contents
        #
        my @files = ();

        if ($real_path ne $root_dir) {
            push(@files, {
                url => "../",
                name => "Up to parent directory",
                size => '',
                mime_type => '',
                mtime => '',
                class => 'parent-directory'
            });
        }

        my $dh = DirHandle->new($real_path);
        my @entries;
        while (defined(my $entry = $dh->read)) {
            next if $entry eq '.' || $entry eq '..';
            next if $entry =~ /^\./ && !$show_hidden_files;
            push @entries, $entry;
        }

        # Mapping of MIME types to CSS class names
        my %classes = (
            'directory' => 'directory',
            'application/javascript' => 'file-application-javascript',
            'application/pdf' => 'file-application-pdf',
            'application/vnd.ms-excel' => 'file-application-vnd-ms-excel',
            'application/vnd.oasis.opendocument.spreadsheet' =>
                'file-application-vnd-oasis-opendocument-spreadsheet',
            'application/vnd.oasis.opendocument.text' =>
                'file-application-vnd-oasis-opendocument-text',
            'application/x-httpd-php' => 'file-application-x-php',
            'application/x-msword' => 'file-application-msword',
            'application/x-perl' => 'file-application-x-perl',
            'application/xml' => 'file-application-xml',
            'application/zip' => 'file-application-zip',
            'image/jpeg' => 'file-image-x-generic',
            'image/png' => 'file-image-x-generic',
            'text/html' => 'file-text-html',
            'text/plain' => 'file-text-plain',
            'text/x-csrc' => 'file-text-x-csrc'
        );

        for my $name (sort { $a cmp $b } @entries) {
            my $file = catfile($real_path, $name);
            my $url = $name;
            $url = join '/', map { uri_escape($_) } split m!/!, $url;

            my $is_dir = -d $file;
            my @stat = stat(_);

            if ($is_dir) {
                $name .= '/';
                $url .= '/';
            }

            my $mime_type = $is_dir ? 'directory' : $mime->for_file($name)
                || '';

            push(@files, {
                url => $url,
                name => $name,
                size => $is_dir ? '' : _format_size($stat[7]),
                mime_type => $mime_type,
                mtime => HTTP::Date::time2str($stat[9]),
                class => $classes{$mime_type} || 'file-unknown'
            });
        }

        if ($template) {
            # Get a new instance of Dancer::Template::Simple
            my $template_simple = Dancer::Engine->build(template => 'simple');
            $template_simple->start_tag('<%');
            $template_simple->stop_tag('%>');

            my $template_dir;

            # Look for the template files in the application's views directory
            if (-d catfile($views_dir, $template)) {
                $template_dir = catfile($views_dir, $template);
            }
            # Then, try the plugin's views directory
            elsif (-d catfile($dist_dir, 'views', $template)) {
                $template_dir = catfile($dist_dir, 'views', $template);
            }
            else {
                # TODO: Template not found -- handle error
            }

            my $file_tpl = catfile($template_dir, 'file.tt');
            my $listing_tpl = catfile($template_dir, 'listing.tt');
            my $layout_tpl = catfile($template_dir, 'layout.tt');

            # Render the list of files
            my $files_html = '';
            for my $file (@files) {
                $files_html .= $template_simple->render($file_tpl,
                    { file => $file });
            }

            # Insert the rendered list into the listing container
            my $listing_html = $template_simple->render($listing_tpl,
                { path => '/' . $path, files => $files_html });

            if ($options{layout}) {
                # Is there a corresponding layout file in the views directory?
                if (-f catfile($views_dir, 'layouts',
                    my $layout_file = $options{layout}))
                {
                    # Display the directory listing using the specified layout
                    # file
                    return $template_simple->apply_layout($listing_html, {}, {
                        layout => $layout_file });
                }
                else {
                    # Use the application's default layout
                    return $template_simple->apply_layout($listing_html);
                }
            }
            else {
                # Display the listing in the template's layout
                return $template_simple->render($layout_tpl,
                    { listing => $listing_html, path => '/' . $path,
                        path_prefix => $path_prefix, request => request,
                        template => 'default' });
            }
        }
        else {
            #
            # Use a basic built-in template
            #
            my $files_html = '';
            for my $file (@files) {
                my $file_html = $builtin_tpl->{file};
                $file_html =~ s/\[%\s*file.(\S*)\s*%\]/$file->{$1}/eg;
                $files_html .= $file_html;
            }
            my $listing_html = $builtin_tpl->{listing};
            $listing_html =~ s/\[%\s*path\s*%\]/"\/".$path/eg;
            $listing_html =~ s/\[%\s*files\s*%\]/$files_html/eg;

            if ($options{layout}) {
                # Get the application's template engine
                my $template = engine 'template';
                if (-f catfile($views_dir, 'layouts',
                    my $layout_file = $options{layout}))
                {
                    # Display the directory listing using the specified layout
                    # file
                    return $template->apply_layout($listing_html, {},
                        { layout => $layout_file });
                }
                else {
                    # Use the default application layout
                    return $template->apply_layout($listing_html);
                }
            }
            else {
                # Use a primitive layout
                (my $html = $builtin_tpl->{layout}) =~
                    s/\[%\s*content\s*%\]/$listing_html/eg;
                $html =~ s/\[%\s*path\s*%\]/"\/".$path/eg;
                return $html;
            }
        }
    }
};

my $path_prefix_re = quotemeta($path_prefix);

get qr{^$path_prefix_re/.*} => sub {
    (my $path = request->path_info) =~ s!^$path_prefix_re/!!;

    send_file(catfile($dist_dir, 'public', split('/', $path)),
        system_path => 1);
};

if (exists $settings->{url}) {
    directory_view $settings->{url} => $settings;
}

if (exists $settings->{directories}) {
    for my $url (keys %{$settings->{directories}}) {
        directory_view $url => $settings->{directories}->{$url} || {};
    }
}

register 'directory_view' => \&directory_view;

register_plugin;

sub _format_size {
    my ($size) = @_;
    $size ||= 0;

    if ($size > 1024**3) {
        return sprintf("%.2f GB", $size / 1024**3);
    }
    elsif ($size > 1024**2) {
        return sprintf("%.2f MB", $size / 1024**2);
    }
    elsif ($size > 1024) {
        return sprintf("%.0f KB", $size / 1024);
    }
    else {
        return sprintf("%d B", $size);
    }
}

# This piece of HTML is borrowed from Plack::App::Directory, which admits to
# have stolen it from rack/directory.rb. The world of open-source is full of
# thieves.
$builtin_tpl->{layout} = <

  [% path %]

   </td>
</tr>

<tr>
<td  class="h" >
<a name="367">367</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> table { width: 100%; } </td>
</tr>

<tr>
<td  class="h" >
<a name="368">368</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> .name { text-align:left; } </td>
</tr>

<tr>
<td  class="h" >
<a name="369">369</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> .size, .mtime { text-align:right; } </td>
</tr>

<tr>
<td  class="h" >
<a name="370">370</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> .type { width:11em; } </td>
</tr>

<tr>
<td  class="h" >
<a name="371">371</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> .mtime { width:15em; } </td>
</tr>

<tr>
<td  class="h" >
<a name="372">372</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">

[% content %]

END
$builtin_tpl->{listing} = <
[% path %]

 




381




 





 





 





 





 





 



    




382




 





 





 





 





 





 



     Name 




383




 





 





 





 





 





 



     Size 




384




 





 





 





 





 





 



     Type 




385




 





 





 





 





 





 



     Last Modified 




386




 





 





 





 





 





 



    




387




 





 





 





 





 





 



 [% files %] 




388






[% files %]


END
$builtin_tpl->{file} = <






END

1; # End of Dancer::Plugin::DirectoryView
__END__