File Coverage

blib/lib/Catalyst/Controller/DirectoryDispatch.pm
Criterion Covered Total %
statement 48 50 96.0
branch 7 8 87.5
condition n/a
subroutine 15 16 93.7
pod 0 5 0.0
total 70 79 88.6


line stmt bran cond sub pod time code
1             package Catalyst::Controller::DirectoryDispatch;
2             # ABSTRACT: Simple directory listing with built in url dispatching
3              
4 1     1   1675627 use Moose;
  1         2  
  1         6  
5 1     1   4685 BEGIN { extends 'Catalyst::Controller' }
6              
7 1     1   3769 use JSON::Any;
  1         3  
  1         9  
8 1     1   160 use Try::Tiny;
  1         2  
  1         60  
9 1     1   4 use namespace::autoclean;
  1         1  
  1         9  
10              
11             __PACKAGE__->config(
12             'default' => 'application/json',
13             'stash_key' => 'response',
14             'map' => {
15             'application/x-www-form-urlencoded' => 'JSON',
16             'application/json' => 'JSON',
17             }
18             );
19              
20              
21             has 'root' => (
22             is => 'ro',
23             isa => 'Str',
24             default => '/',
25             );
26              
27             has 'full_paths' => (
28             is => 'ro',
29             isa => 'Bool',
30             default => 0,
31             );
32              
33             has 'filter' => (
34             is => 'ro',
35             isa => 'RegexpRef',
36             );
37              
38             has 'data_root' => (
39             is => 'ro',
40             isa => 'Str',
41             default => 'data',
42             );
43              
44              
45 1     1 0 151 sub setup :Chained('specify.in.subclass.config') :CaptureArgs(0) :PathPart('specify.in.subclass.config') {}
  1     7   1  
  1         10  
46              
47              
48             sub list :Chained('setup') :PathPart('') :Args {
49 7     7 0 1691 my $self = shift;
50 7         13 my $c = shift;
51              
52 7         21 my $path = join '/', @_;
53 7 100       24 $path = "/$path" if ($path);
54 7         227 my $full_path = $self->root . $path;
55              
56 7         216 my $regexp = $self->filter;
57 7         15 my $files = [];
58              
59             try {
60 7 50   7   612 opendir (my $dir, $full_path) or die;
61 7         151 $files = [ readdir $dir ];
62 7         221 closedir $dir;
63             } catch {
64 0     0   0 $c->stash->{response} = {"error" => "Failed to open directory '$full_path'", "success" => JSON::Any::false};
65 0         0 $c->detach('serialize');
66 7         75 };
67              
68 7 100       105 $files = [ grep { !/$regexp/ } @$files ] if ($regexp);
  17         46  
69              
70 7 100       395 $files = [ map { "$path/$_" } @$files ] if ($self->full_paths);
  20         29  
71              
72 7         37 $files = $self->process_files($c, $files);
73              
74 7         50 $c->stash->{response}->{$self->data_root} = $files;
75 7         33 $c->stash->{response}->{success} = JSON::Any::true;
76 1     1   1203 }
  1         1  
  1         3  
77              
78              
79             sub process_files {
80 6     6 0 13 my ( $self, $c, $files ) = @_;
81            
82 6         10 return $files;
83             }
84              
85              
86             sub end :Privete {
87 7     7 0 6202 my ( $self, $c ) = @_;
88            
89 7         27 $c->res->status(200);
90 7         783 $c->forward('serialize');
91 1     1   853 }
  1         2  
  1         15  
92              
93              
94 1     1 0 752 sub serialize :ActionClass('Serialize') {}
  1     7   1  
  1         4  
95              
96              
97             __PACKAGE__->meta->make_immutable;
98             1;
99              
100             __END__
101              
102             =head1 NAME
103              
104             Catalyst::Controller::DirectoryDispatch - A controller for browsing system directories
105              
106             =head1 SYNOPSIS
107              
108             package MyApp::Controller::Browser::Example;
109             use Moose;
110             BEGIN { extends 'Catalyst::Controller::DirectoryDispatch' }
111            
112             __PACKAGE__->config(
113             action => { setup => { Chained => '/browser/base', PathPart => 'mydir' } },
114             root => '/home/andy',
115             filter => qr{^\.|.conf$},
116             data_root => 'data',
117             full_paths => 1,
118             );
119              
120             =head1 DESCRIPTION
121              
122             Provides a simple configuration based controller for listing local system directories and dispatching them as URLs.
123              
124             =head2 Example Usage
125              
126             If you created the controller at http://localhost/mydir and set root to '/home/user1' then browsing to the controller might give the following output:
127              
128             {
129             "success":true,
130             "data":[
131             "file1",
132             "file2",
133             "dir1",
134             "dir2"
135             ],
136             }
137              
138             You could then point your browser to http://localhost/mydir/dir1 to get a directory listing of the folder '/home/user1/dir1' and so on...
139              
140             =head2 Changing Views
141              
142             The default view for DirectoryDispatch serializes the file list as JSON but it's easy to change it to whatever view you'd like.
143              
144             __PACKAGE__->config(
145             'default' => 'text/html',
146             'map' => {
147             'text/html' => [ 'View', 'TT' ],
148             }
149             );
150              
151             Then in your template...
152              
153             [% FOREACH node IN response.data %]
154             [% node %]
155             [% END %]
156              
157             =head2 Post Processing
158              
159             If you need to process the files in anyway before they're passed to the view you can override process_files in your controller.
160              
161             sub process_files {
162             my ($self, $c, $files) = @_;
163              
164             foreach my $file ( @$files ) {
165             # Modify $file
166             }
167              
168             return $files;
169             }
170              
171             This is the last thing that happens before the list of files are passed on to the view. $files is sent in as an ArrayRef[Str] but you
172             are free to return any thing you want as long as the serializer you're using can handle it.
173              
174             =head1 CONFIGURATION
175              
176             =head2 root
177              
178             is: ro, isa: Str
179              
180             The folder that will be listed when accessing the controller (default '/').
181              
182             =head2 filter
183              
184             is: ro, isa: RegexpRef
185              
186             A regular expression that will remove matching files or folders from the directory listing (default: undef).
187              
188             =head2 data_root
189              
190             is: ro, isa: Str
191              
192             The name of the key inside $c->stash->{response} where the directory listing will be stored (default: data).
193              
194             =head2 full_paths
195              
196             is: ro, isa: Bool
197              
198             Returns full paths for the directory listing rather than just the names (default: 0).
199              
200             =head1 AUTHOR
201              
202             Andy Gorman, agorman@cpan.org
203              
204             =head1 THANKS
205              
206             The design for this module was heavly influenced by the fantastic L<Catalyst::Controller::DBIC::API>.
207              
208             =head1 COPYRIGHT AND LICENSE
209              
210             This is free software; you can redistribute it and/or modify it under
211             the same terms as the Perl 5 programming language system itself.